rw = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1

--

HTH

RP
(remove nothere from the email address if mailing direct)


"J_J" wrote in message
...
Hi,
The below code copies records that has a non blank cells in column C from
Sheet1 to Sheet2. So far so good. But it re-writes on top of the old
records
on Sheet2. How can I modify it so that it'll check for empty rows on
Sheet2
and then copy data from Sheet1 to Sheet2?.
TIA

'---------------------------------
Sub Copy_them()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long, rng2 As Range
col = 3
rw = 2
With Worksheets("sheet1")
Set rng = .Range(.Cells(2, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) < "" Then
cell.EntireRow.Copy Destination:=Worksheets("sheet2") _
.Cells(rw, 1)
rw = rw + 1
If rng2 Is Nothing Then
Set rng2 = cell
Else
Set rng2 = Union(rng2, cell)
End If
End If
Next
If Not rng2 Is Nothing Then
rng2.EntireRow.Delete
End If
End Sub
'-------------------------------