Copying cell content in Excel

[uravi]

Hi All,

Could you let me know is there a possible and a simplest way to copy the cell content. I have an Excel worksheet like this:

1 a1 a2 a3 a4 a5 a6 a7 a8 a9
2 b1 b2 b3 b4 b5
3 c1 c2 c3 c4 c5 c6 c7
4 d1 d2 d3 d4

and so on.....

And I want the result to be like this:
1 a1
1 a2
1 a3
1 a4
1 a5
1 a6
1 a7
1 a8
2 b1
.
.
2 b5
3 c1
.
.
3 c7
4 d1
.
.
4 d4

I have some 500 lines like this.

Can any one help.

Thanks

 

[OlafBogus]

Ok heres a little macro that will do what i think you want
Sub Macro2()
Dim row_ID As Integer
Dim cell_ID As Integer
Dim NextEmpty As Integer
Dim LastEntry As Integer
Dim done As Boolean
cell_ID = 0
row_ID = 0
NextEmpty = 0
LastEntry = 0
done = False
Range("A1&quot.Select
While (IsEmpty(Selection.Offset(NextEmpty, 0).Value) = False)
NextEmpty = NextEmpty + 1
Wend
LastEntry = NextEmpty
While ((IsEmpty(Selection.Offset(0, cell_ID).Value) = False) And (done = False))
While (IsEmpty(Selection.Offset(0, cell_ID).Value) = False)
cell_ID = cell_ID + 1
Wend
cell_ID = cell_ID - 1
Range(Selection, Selection.Offset(0, cell_ID)).Select
Selection.Copy
Range("A1&quot.Select
Range(Selection.Offset(NextEmpty, 0), Selection.Offset(NextEmpty + cell_ID, 0)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
NextEmpty = NextEmpty + cell_ID + 1
row_ID = row_ID + 1
cell_ID = 0
If (row_ID = LastEntry) Then
done = True
End If
Range("A1&quot.Select
Selection.Offset(row_ID, 0).Select
Wend
End Sub

 

[uravi]

Thank you OlafBogus,

It is working fine.

But it copying the data in the same worksheet. if I want it in a worksheet, What can I do?

Many Thanks.

 

[OlafBogus]

try this...type in source sheet name hit ok type in destination sheet name hit ok...

Sub Macro1()
Dim SourceSheetName As String
Dim DestinationSheetName As String
Dim row_ID As Integer
Dim cell_ID As Integer
Dim NextEmpty As Integer
Dim LastEntry As Integer
Dim done As Boolean
SourceSheetName = InputBox("Enter Sheet Name to copy from&quot
DestinationSheetName = InputBox("Enter Sheet Name to copy to&quot
cell_ID = 0
row_ID = 0
NextEmpty = 0
LastEntry = 0
done = False
Sheets(DestinationSheetName).Select
Range("A1&quot.Select
While (IsEmpty(Selection.Offset(NextEmpty, 0).Value) = False)
NextEmpty = NextEmpty + 1
Wend
LastEntry = NextEmpty
Sheets(SourceSheetName).Select
Range("A1&quot.Select
While ((IsEmpty(Selection.Offset(0, cell_ID).Value) = False) And (done = False))
While (IsEmpty(Selection.Offset(0, cell_ID).Value) = False)
cell_ID = cell_ID + 1
Wend
cell_ID = cell_ID - 1
Range(Selection, Selection.Offset(0, cell_ID)).Select
Selection.Copy
Sheets(DestinationSheetName).Select
Range("A1&quot.Select
Range(Selection.Offset(NextEmpty, 0), Selection.Offset(NextEmpty + cell_ID, 0)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
NextEmpty = NextEmpty + cell_ID + 1
row_ID = row_ID + 1
cell_ID = 0
If (row_ID = LastEntry) Then
done = True
End If
Sheets(SourceSheetName).Select
Range("A1&quot.Select
Selection.Offset(row_ID, 0).Select
Wend
End Sub

 

[TonyU]

[tt]Wow, that's alot to swallow (one reason I'll stick to .asp and .net stuff)

I would have just linked from the first sheet to whatever sheet I needed to and drag-copying the cell formula as far down as I would've needed it.


='Sheet1'!A1

Delete * from brain Where MaxLevel = "Full" and reaction = "Slow" order by StartOver
​