Macro Help
 

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:P" &
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

Macro Help
 

Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End(xlUp).Row

Set rngSource = wsSource.Range("A2:P" & 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
Next wsSource
End Sub

--
Regards,
Tom Ogilvy


"Simon Dowse" wrote in message
...
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:P" &
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

Macro Help
 

Many thanks!

I've input this as below and when I go to 'Compile VBA
Project' I get an error message that says:

Compile Error:
Next without For

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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
Next wsSource
End Sub

--
Regards,
Tom Ogilvy


"Simon Dowse" wrote
in message
...
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:P" &
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


.

Macro Help
 

Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End(xlUp).Row

Set rngSource = wsSource.Range("A2:P" & 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 if '<=== added line
Next wsSource
End Sub

--
Regards,
Tom Ogilvy

wrote in message
...
Many thanks!

I've input this as below and when I go to 'Compile VBA
Project' I get an error message that says:

Compile Error:
Next without For

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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
Next wsSource
End Sub

--
Regards,
Tom Ogilvy


"Simon Dowse" wrote
in message
...
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:P" &
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


.

Macro Help
 

Ok, that compiled.

Now when I try and run the macro it brings up a new
message:

Run-time error '1004':
AutoFilter method of range class failed

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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 if '<=== added line
Next wsSource
End Sub

--
Regards,
Tom Ogilvy

wrote in message
...
Many thanks!

I've input this as below and when I go to 'Compile VBA
Project' I get an error message that says:

Compile Error:
Next without For

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As
Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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
Next wsSource
End Sub

--
Regards,
Tom Ogilvy


"Simon Dowse"
wrote
in message
...
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:P" &
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


.



.

Macro Help
 

That would indicate that you don't have the data in the worksheet to support
putting in an autofilter that would have 12 columns (so you can filter on
the 12th column). At least such data doesn't start in column A.

You could check whether there is any point to it:

Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range, rng as range, rng1 as Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End(xlUp).Row

Set rngSource = wsSource.Range("A2:P" & lngSourceLastRow)
set rng = Intersect(rngSource, wsSource.Columns(12))
set rng1 = Nothing
set rng1 = rng.Find("Red")
if not rng1 is nothing then
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
Else
msgbox "No Reds in sheet " & wsSource
End if
End if '<=== added line
Next wsSource
End Sub

--
Regards,
Tom Ogilvy



wrote in message
...
Ok, that compiled.

Now when I try and run the macro it brings up a new
message:

Run-time error '1004':
AutoFilter method of range class failed

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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 if '<=== added line
Next wsSource
End Sub

--
Regards,
Tom Ogilvy

wrote in message
...
Many thanks!

I've input this as below and when I go to 'Compile VBA
Project' I get an error message that says:

Compile Error:
Next without For

Any ideas?

-----Original Message-----
Sub FilterTest()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lngSourceLastRow As Long, lngTargetLastRow As
Long
Dim rngSource As Range

Set wsTarget = Worksheets("Risk Board Report")

for each wsSource in Worksheets
if wsSource.name < wsTarget.name then
lngSourceLastRow = wsSource.Range("B65536").End
(xlUp).Row
lngTargetLastRow = wsTarget.Range("A65536").End
(xlUp).Row

Set rngSource = wsSource.Range("A2:P" &
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
Next wsSource
End Sub

--
Regards,
Tom Ogilvy


"Simon Dowse"
wrote
in message
...
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:P" &
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


.



.