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
'-------------------------------

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
'-------------------------------

Hi Bob,
Thank you for your suggestion. Unfortunately that didn't help. When I
replaced the code with the new def. of rw
run the macro, get 4 records copied to Sheet2, fill in a cell from column C
and run the macro again, it just copied the new item on top of the old
record previously copied from the first run.
What am I doing wrong here?
Sincerely
J_J

"Bob Phillips" wrote in message
...
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
'-------------------------------

J_J,

Did you put it in the correct place? I meant replace this

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 this

Sub Copy_them()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long, rng2 As Range
col = 3
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 Bob,
Thank you for your suggestion. Unfortunately that didn't help. When I
replaced the code with the new def. of rw
run the macro, get 4 records copied to Sheet2, fill in a cell from column
C
and run the macro again, it just copied the new item on top of the old
record previously copied from the first run.
What am I doing wrong here?
Sincerely
J_J

"Bob Phillips" wrote in message
...
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
'-------------------------------

Thank you Bob,
I have replaced the wrong statement...
Now it works perfectly well.
J_J


"Bob Phillips" wrote in message
...
J_J,

Did you put it in the correct place? I meant replace this

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 this

Sub Copy_them()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long, rng2 As Range
col = 3
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 Bob,
Thank you for your suggestion. Unfortunately that didn't help. When I
replaced the code with the new def. of rw
run the macro, get 4 records copied to Sheet2, fill in a cell from column
C
and run the macro again, it just copied the new item on top of the old
record previously copied from the first run.
What am I doing wrong here?
Sincerely
J_J

"Bob Phillips" wrote in message
...
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
'-------------------------------