Change ws designator

  • Thread starter Thread starter Guest
  • Start date Start date
G

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: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
 
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
 
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?
 
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:

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
 
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.
 
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.
 
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.
 
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)
 
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?
 
one way:

Go back to the

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

construction.
 
Back
Top