Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Macro Help
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default 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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
No Name
 
Posts: n/a
Default 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


.

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default 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


.



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
No Name
 
Posts: n/a
Default 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


.



.

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default 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


.



.



Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro recorded... tabs & file names changed, macro hangs Steve Excel Worksheet Functions 3 October 30th 09 11:41 AM
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort Gavin Excel Worksheet Functions 0 May 17th 07 01:20 PM
My excel macro recorder no longer shows up when recording macro jack Excel Discussion (Misc queries) 3 February 5th 07 08:22 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 11:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement