Thread: moving rows
View Single Post
  #4   Report Post  
Paulw2k
 
Posts: n/a
Default

Hi,

Assuming all data downloaded into column A then this macro should do it.

Sub ReorderMacro()
Rem This macro assumes all data is in Column A
Rem and moves the values in every 2nd and 3rd row
Rem into the adjacent columns in every 1st row.
Rem Using the autofilter removes the resulting empty rows.

Dim Rng As Range
Dim lOffset As Long

Set Rng = Range("A1")
With Rng
Do Until IsEmpty(.Offset(lOffset, 0))
Rem place values in next 2 cells down in columns immediately to
the right
.Offset(lOffset, 1).Value = .Offset(lOffset + 1, 0).Value
.Offset(lOffset, 2).Value = .Offset(lOffset + 2, 0).Value
Rem clear these values from original cells
.Offset(lOffset + 1, 0).Clear
.Offset(lOffset + 2, 0).Clear
Rem Move to next "1st" row (1,4,7,10, ... )
lOffset = lOffset + 3
Loop
End With

Rem delete empty Rows created
Set Rng = ActiveSheet.UsedRange

ActiveSheet.AutoFilterMode = False
With Rng
Rem Filter on first column for empty cells
.AutoFilter Field:=1, Criteria1:="="
Rem If More than one row is visible, remove all visible except row
1.
If .SpecialCells(xlCellTypeVisible).Count .Columns.Count Then _
.Rows("2:" &
CStr(.Rows.Count)).Cells.SpecialCells(xlCellTypeVi sible).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False

End Sub


Hope this helps

Regards

Paul







End Sub







"cdshon" wrote in message
...
I have a large report in tab or csv format that creates 3 rows of data in
Excel that I want to move to a single row. Cut and paste will take
forever.
What can I do?