Change ws designator

[Guest]

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" & 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]

set ws = worksheets("new ip office")
For Each cell In ws.Range("D1" & 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

 

[JE McGimpsey]

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

 

[Guest]

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?

 

[Guest]

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]

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

 

[Dave Peterson]

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

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

 

[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.

 

[Guest]

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]

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)

 

[Guest]

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]

one way:

Go back to the

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

construction.