Copying Filtered Data from multiple worksheets

[Paul Moss]

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

 

[Paul Moss]

Forgot to add on previous post. The data that comes across isn't what shows

 

[joel]

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]

Thanks Joel that worked a treat. Thank you very much