Hello,

I have the following code below. I have a total of 7 seperate worksheets
within a workbook that I want this macro to run on. Essentially I want to be
able to copy any row that has a number in column B. This macro works great
for one worksheet, but I want to be able to take all 7 sheets and combine
into one sheet.

Thanks in advance.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub

"ScottMSP" wrote:

Hello,

I have the following code below. I have a total of 7 seperate worksheets
within a workbook that I want this macro to run on. Essentially I want to be
able to copy any row that has a number in column B. This macro works great
for one worksheet, but I want to be able to take all 7 sheets and combine
into one sheet.

Thanks in advance.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub

Joel,

The macro failed. It looks like it failed on this line:

RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))

Thoughts?

Thanks in advance.

"Joel" wrote:

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub

"ScottMSP" wrote:

Hello,

I have the following code below. I have a total of 7 seperate worksheets
within a workbook that I want this macro to run on. Essentially I want to be
able to copy any row that has a number in column B. This macro works great
for one worksheet, but I want to be able to take all 7 sheets and combine
into one sheet.

Thanks in advance.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub

Union won't work across multiple worksheets. We need to set the Union to
nothing as we change worksheets.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
Set RowsWithNumbers = Nothing
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub


"ScottMSP" wrote:

Joel,

The macro failed. It looks like it failed on this line:

RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))

Thoughts?

Thanks in advance.

"Joel" wrote:

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub

"ScottMSP" wrote:

Hello,

I have the following code below. I have a total of 7 seperate worksheets
within a workbook that I want this macro to run on. Essentially I want to be
able to copy any row that has a number in column B. This macro works great
for one worksheet, but I want to be able to take all 7 sheets and combine
into one sheet.

Thanks in advance.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub

Thanks Joel. It appears to have worked!

"Joel" wrote:

Union won't work across multiple worksheets. We need to set the Union to
nothing as we change worksheets.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
Set RowsWithNumbers = Nothing
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub


"ScottMSP" wrote:

Joel,

The macro failed. It looks like it failed on this line:

RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))

Thoughts?

Thanks in advance.

"Joel" wrote:

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
For Each sht In Sheets
If UCase(sht.Name) < ("SHEET2") Then
With sht
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value <
"" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X,
"B"))
End If
End If
Next X
If Not RowsWithNumbers Is Nothing Then
LastRow = Destination.Cells(Rows.Count, "B").End(xlUp).Row
RowsWithNumbers.EntireRow.Copy Destination.Range("A" & (LastRow
+ 1))
End If
End With
End If
Next sht
End Sub

"ScottMSP" wrote:

Hello,

I have the following code below. I have a total of 7 seperate worksheets
within a workbook that I want this macro to run on. Essentially I want to be
able to copy any row that has a number in column B. This macro works great
for one worksheet, but I want to be able to take all 7 sheets and combine
into one sheet.

Thanks in advance.

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Clinical Nursing")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub