Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson