PDA

View Full Version : Solved: Macro for finding rows and copying to a new sheet.



twelvety
12-01-2009, 04:44 AM
Hi,

I want to write a macro which looks at column F in sheet1 and for all the cells in column F which aren't empty, copies the rows to the next available rows in sheet2, then deletes the original rows in sheet1.
The macro needs to ignore the contents of F1.

Any help is much appreciated.

Thanks

Bob Phillips
12-01-2009, 06:56 AM
Public Sub PreocessData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long
Dim sh As Worksheet

Set sh = Worksheets("Sheet2")
NextRow = sh.Range("F1").End(xlDown).Row
With ActiveSheet

LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "F").Value <> "" Then

NextRow = NextRow + 1
.Rows(i).Copy sh.Cells(NextRow, "A")
.Rows(i).Delete
End If
Next i
End With

End Sub

GTO
12-01-2009, 11:13 AM
Greetings,

I was thinking maybe:

Sub exa()

With Worksheets("Sheet1")
With .Range(.Range("F2"), .Cells(Rows.Count, "F").End(xlUp))
.AutoFilter 1, "=*"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells(Rows.Count, "F").End(xlUp).Offset(1, -5)
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub


Hope that helps,

Mark