Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Copying Filtered Data from multiple worksheets
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3
Default Copying Filtered Data from multiple worksheets
Hi I am trying create a macro that will copy filtered data from multiple
worksheets into one master worksheet. I have created the following code using
examples from this forum.

Sheets("PRINT - MILL").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets(2).Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(14, 0).Range("A1").Select
Sheets("PRINT - SVR").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=18
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - BRZ").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - WHT").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

I am currently experiencing a few problems with this coding. I need it to
paste the data from each sheet on to the master sheet and leave a blank row
in between. Please can you help?

Regards

Paul
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3
Default Copying Filtered Data from multiple worksheets
Forgot to add on previous post. The data that comes across isn't what shows
on the seperate work sheets

"Paul Moss" wrote:

Hi I am trying create a macro that will copy filtered data from multiple
worksheets into one master worksheet. I have created the following code using
examples from this forum.

Sheets("PRINT - MILL").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets(2).Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(14, 0).Range("A1").Select
Sheets("PRINT - SVR").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=18
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - BRZ").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - WHT").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

I am currently experiencing a few problems with this coding. I need it to
paste the data from each sheet on to the master sheet and leave a blank row
in between. Please can you help?

Regards

Paul
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copying Filtered Data from multiple worksheets
Sub PrintSheets()

PrintShts = Array("PRINT - MILL", "PRINT - SVR", _
"PRINT - BRZ", "PRINT - WHT")

First = True
For Each sht In PrintShts

With Sheets(sht)
Set Rng = .AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then

LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Rows("2:" & LastRow)
CopyRange.Copy

If First = True Then
Newrow = 4
First = False
Else
LastRow = Sheets("MASTER PRINT") _
.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 2
End If

Sheets("MASTER PRINT").Range("A" & Newrow).PasteSpecial _
Paste:=xlPasteValues
Else
MsgBox "No visible data"
End If
End With
Next sht
End Sub


"Paul Moss" wrote:

Hi I am trying create a macro that will copy filtered data from multiple
worksheets into one master worksheet. I have created the following code using
examples from this forum.

Sheets("PRINT - MILL").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets(2).Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(14, 0).Range("A1").Select
Sheets("PRINT - SVR").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=18
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - BRZ").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - WHT").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

I am currently experiencing a few problems with this coding. I need it to
paste the data from each sheet on to the master sheet and leave a blank row
in between. Please can you help?

Regards

Paul
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3
Default Copying Filtered Data from multiple worksheets
Thanks Joel that worked a treat. Thank you very much

"joel" wrote:

Sub PrintSheets()

PrintShts = Array("PRINT - MILL", "PRINT - SVR", _
"PRINT - BRZ", "PRINT - WHT")

First = True
For Each sht In PrintShts

With Sheets(sht)
Set Rng = .AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then

LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Rows("2:" & LastRow)
CopyRange.Copy

If First = True Then
Newrow = 4
First = False
Else
LastRow = Sheets("MASTER PRINT") _
.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 2
End If

Sheets("MASTER PRINT").Range("A" & Newrow).PasteSpecial _
Paste:=xlPasteValues
Else
MsgBox "No visible data"
End If
End With
Next sht
End Sub


"Paul Moss" wrote:

Hi I am trying create a macro that will copy filtered data from multiple
worksheets into one master worksheet. I have created the following code using
examples from this forum.

Sheets("PRINT - MILL").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets(2).Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(14, 0).Range("A1").Select
Sheets("PRINT - SVR").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=18
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - BRZ").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(11, 0).Range("A1").Select
Sheets("PRINT - WHT").Select
Set Rng = ActiveSheet.AutoFilter.Range
If Rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=Worksheets("MASTER PRINT").Range("A4")
Else
MsgBox "No visible data"
End If
Selection.Copy
Sheets("MASTER PRINT").Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

I am currently experiencing a few problems with this coding. I need it to
paste the data from each sheet on to the master sheet and leave a blank row
in between. Please can you help?

Regards

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

Advanced Search
Display Modes
Linear Mode Linear 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
Copying filtered data Steve Wallis Excel Programming 0 July 2nd 08 01:24 PM
copying data from multiple worksheets Steve Irmin Excel Discussion (Misc queries) 1 September 22nd 07 04:50 AM
Copying data from multiple worksheets PullingMyHairOut Excel Discussion (Misc queries) 1 November 21st 06 11:00 PM
Copying data to multiple worksheets by Macro lqfong Excel Discussion (Misc queries) 0 June 26th 06 03:57 AM
Copying filtered data cghall55 Excel Programming 5 January 11th 05 04:14 PM


All times are GMT +1. The time now is 08:13 AM.

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

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement