S
Simon Dowse
Hi,
Using the below macro I can copy the contents of 1 sheet
to another where the contents of row 12 is red. As I have
more that 1 sheet in my spreadsheet, how do I extend this
so that it also copied from the other sheets?
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range
Set wsSource = Worksheets("Storage Consolidation")
Set wsTarget = Worksheets("Risk Board Report")
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row
Set rngSource = wsSource.Range("A2
" &
lngSourceLastRow)
wsSource.Range("A1").AutoFilter Field:=12,
Criteria1:="Red"
On Error Resume Next
Set rngSource = rngSource.SpecialCells
(xlCellTypeVisible)
If rngSource Is Nothing Then Exit Sub ' no
visible cells
rngSource.Copy wsTarget.Range("A" & lngTargetLastRow +
1)
wsSource.Range("A1").AutoFilter
End Sub
Any help would be greatly appreciated.
Regards,
Simon
Using the below macro I can copy the contents of 1 sheet
to another where the contents of row 12 is red. As I have
more that 1 sheet in my spreadsheet, how do I extend this
so that it also copied from the other sheets?
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range
Set wsSource = Worksheets("Storage Consolidation")
Set wsTarget = Worksheets("Risk Board Report")
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row
Set rngSource = wsSource.Range("A2

lngSourceLastRow)
wsSource.Range("A1").AutoFilter Field:=12,
Criteria1:="Red"
On Error Resume Next
Set rngSource = rngSource.SpecialCells
(xlCellTypeVisible)
If rngSource Is Nothing Then Exit Sub ' no
visible cells
rngSource.Copy wsTarget.Range("A" & lngTargetLastRow +
1)
wsSource.Range("A1").AutoFilter
End Sub
Any help would be greatly appreciated.
Regards,
Simon