Macro from rows to coloumns

[quincymondragon]

Hi all, i've got a file excel with this scheme:

[TABLE="width: 860"]
<tbody>[TR]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[/TR]
[TR]
[TD]Lat. #1[/TD]
[TD]Long. #1[/TD]
[TD]Lat. #2[/TD]
[TD]Long. #2[/TD]
[TD]Lat. #3[/TD]
[TD]Long. #3[/TD]
[TD]Lat. #4[/TD]
[TD]Long. #4[/TD]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[/TR]
[TR]
[TD]Lat. #5[/TD]
[TD]Long. #5[/TD]
[TD]Lat. #6[/TD]
[TD]Long. #6[/TD]
[TD]Lat. #7[/TD]
[TD]Long. #7[/TD]
[TD]Lat. #8[/TD]
[TD]Long. #8[/TD]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[/TR]
[TR]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

i wolud like to traspose into this:

[TABLE="width: 172"]
<tbody>[TR]
[TD="width: 86"]Lat[/TD]
[TD="width: 86"]Long[/TD]
[/TR]
[TR]
[TD]Lat. #1[/TD]
[TD]Long. #1[/TD]
[/TR]
[TR]
[TD]Lat. #2[/TD]
[TD]Long. #2[/TD]
[/TR]
[TR]
[TD]Lat. #3[/TD]
[TD]Long. #3[/TD]
[/TR]
[TR]
[TD]Lat. #4[/TD]
[TD]Long. #4[/TD]
[/TR]
[TR]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[/TR]
[TR]
[TD]Lat. #5[/TD]
[TD]Long. #5[/TD]
[/TR]
[TR]
[TD]Lat. #6[/TD]
[TD]Long. #6[/TD]
[/TR]
[TR]
[TD]Lat. #7[/TD]
[TD]Long. #7[/TD]
[/TR]
[TR]
[TD]Lat. #8[/TD]
[TD]Long. #8[/TD]
[/TR]
[TR]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[/TR]
[TR]
[TD]Lat. #...[/TD]
[TD]Long. #...[/TD]
[/TR]
</tbody>[/TABLE]

How i could do this with a macro? Someone could help me?
Thank you!!!

 

[patel45]

result on sheet 2

Sub a()
LC = ActiveSheet.UsedRange.Columns.Count
LR = ActiveSheet.UsedRange.Rows.Count
drow = 2
For j = 2 To LR
  For c = 1 To LC Step 2
    Range(Cells(j, c), Cells(j, c + 1)).Copy Sheets(2).Cells(drow, "A")
    drow = drow + 1
  Next
Next
End Sub

 

[quincymondragon]

Ok, i've tried, it works!!
However, i modified '.Copy Sheets(2).' into '.Copy Sheet("Name Sheet").' and it overwrites data presents into the next row.
Which code i could write to insert n row as coloumn to be inserted or max coloumn used in the sheet?

Thank you again!

 

[quincymondragon]

So, i've adjust the code to my case, here is what i've got:

Dim drow, d, j, c, col1, col2, col3 As Integer

Sub a()
LC = 0
LR = 0
col1 = 1
col2 = 3
col3 = 5

LC = ActiveSheet.UsedRange.Columns.Count
LR = ActiveSheet.UsedRange.Rows.Count
drow = 2

For j = 2 To LR
For c = 7 To LC Step 2

If Cells(j, c) = "0" Then j = j + 1
If Cells(j, c) = "0" Then c = 7
If IsEmpty(Cells(j, c)) Then j = j + 1
If IsEmpty(Cells(j, c)) Then c = 7

Range(Cells(j, col1), Cells(j, col1 + 1)).Copy Sheets("Foglio2").Cells(drow, "A")
Range(Cells(j, col2), Cells(j, col2 + 1)).Copy Sheets("Foglio2").Cells(drow, "C")
Range(Cells(j, col3), Cells(j, col3 + 1)).Copy Sheets("Foglio2").Cells(drow, "E")

Range(Cells(j, c), Cells(j, c + 1)).Copy Sheets("Foglio2").Cells(drow, "G")
drow = drow + 1

Next
Next

End Sub


However, it loops a lot during the copy-paste of last row, i couldn't understand why. Someone could help me?!?
Thank you