Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

set ws = worksheets("new ip office")
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell



Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

--

Dave Peterson

One way:

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(1, 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 IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End With
Next rCell
End If


In article ,
Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

Thanks Dave. The only problem is that this macro only picks up the highest
numbered cell. it does not start at the top of the D col and scan all of the
cells down to find if there are any values. Any ideas?

"Dave Peterson" wrote:

set ws = worksheets("new ip office")
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell



Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

--

Dave Peterson

Thanks...This macro finds the first value in col D and the last however it
also copies all of the blank cells in between the first and last value of the
col. Can that be fixed?

"JE McGimpsey" wrote:

One way:

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(1, 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 IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End With
Next rCell
End If


In article ,
Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

One way:

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(1, 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


In article ,
Jerry Foley wrote:

Thanks...This macro finds the first value in col D and the last however it
also copies all of the blank cells in between the first and last value of the
col. Can that be fixed?

It looks at all the cells in D1:D(lastusedrowincolumnD).

I'm not sure why you say it only looks at the highest numbered cell.



Jerry Foley wrote:

Thanks Dave. The only problem is that this macro only picks up the highest
numbered cell. it does not start at the top of the D col and scan all of the
cells down to find if there are any values. Any ideas?

"Dave Peterson" wrote:

set ws = worksheets("new ip office")
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell



Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

--

Dave Peterson


--

Dave Peterson

Ps. JE gave you a way to avoid empty cells when checking isnumeric.

Another way is to use:

if application.isnumber(cell.value) then

The worksheet function =isnumber() is more strict.

Dave Peterson wrote:

It looks at all the cells in D1:D(lastusedrowincolumnD).

I'm not sure why you say it only looks at the highest numbered cell.

Jerry Foley wrote:

Thanks Dave. The only problem is that this macro only picks up the highest
numbered cell. it does not start at the top of the D col and scan all of the
cells down to find if there are any values. Any ideas?

"Dave Peterson" wrote:

set ws = worksheets("new ip office")
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell



Jerry Foley wrote:

Hello, Given the following macro:
Sub mastertest()

Dim ws As Worksheet, cell As Range, rng As Range

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet2" Then
For Each cell In ws.Range("D1:D" & ws.Range("D65536").End(xlUp).Row)
If IsNumeric(cell) = True Then
cell.EntireRow.Copy _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset( 1, 0)
End If
Next cell
End If

Next ws

End Sub

How do I edit it to only seach col D only in the spreadsheet tab "New IP
Office" and write the results in Sheet2?

--

Dave Peterson


--

Dave Peterson

--

Dave Peterson

Thanks much...it works great. One last question...How can I specify for the
rows being copied to sheet2 to start at row 12 of sheet2.

i appreaciate yor help.

"JE McGimpsey" wrote:

One way:

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(1, 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


In article ,
Jerry Foley wrote:

Thanks...This macro finds the first value in col D and the last however it
also copies all of the blank cells in between the first and last value of the
col. Can that be fixed?

One way:

Change

Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(1, 0)

to

Set rDest = .Parent.Sheets("Sheet2").Cells(12, 1)



In article ,
Jerry Foley wrote:

Thanks much...it works great. One last question...How can I specify for the
rows being copied to sheet2 to start at row 12 of sheet2.

Thanks...in the future if I want this macro to run on all of the worksheets
in the workbook what would I need to change?

"JE McGimpsey" wrote:

One way:

Change

Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(1, 0)

to

Set rDest = .Parent.Sheets("Sheet2").Cells(12, 1)



In article ,
Jerry Foley wrote:

Thanks much...it works great. One last question...How can I specify for the
rows being copied to sheet2 to start at row 12 of sheet2.

one way:

Go back to the

For Each ws In Worksheets
If ws.Name < "Sheet2" Then
'...
End if
Next ws

construction.

In article ,
Jerry Foley wrote:

Thanks...in the future if I want this macro to run on all of the worksheets
in the workbook what would I need to change?