Hi,
You can look at this code too see if it will help you.
It loops thru specific sheet and applies a filter then copy and paste to a worksheet.
Code:
Sub test41()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Sws As Worksheet
Dim Rng As Range
Dim Myval As Long
Set Sws = Sheets("Summary")
'''' Unhide Summary columns "K thru Q'''''
Sws.Columns("K:Q").Hidden = True
''''
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
If InStr("Lookup", ws.Name) = 0 And InStr("Summary", ws.Name) = 0 Then
Select Case ws.Name
Case "Crawler"
Range("A1:d1").Select
ws.Columns("K:R").Hidden = False
Selection.AutoFilter
With Selection
.AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
End With
Set Rng = ActiveSheet.AutoFilter.Range
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
'' make sure you have more than 1 row to copy ''
Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
If Myval <> "1" Then
Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
Application.CutCopyMode = xlCopy
End If
Case "Various"
Range("A1:d1").Select
ws.Columns("K:R").Hidden = False
Selection.AutoFilter
With Selection
.AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
End With
Set Rng = ActiveSheet.AutoFilter.Range
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
'' make sure you have more than 1 row to copy ''
Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
If Myval <> "1" Then
Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
Application.CutCopyMode = xlCopy
End If
Case "MandM"
Range("A1:d1").Select
ws.Columns("K:R").Hidden = False
Selection.AutoFilter
With Selection
.AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
End With
Set Rng = ActiveSheet.AutoFilter.Range
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
'' make sure you have more than 1 row to copy ''
Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
If Myval <> "1" Then
Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
Application.CutCopyMode = xlCopy
End If
Case "Fragrance"
Range("A1:d1").Select
ws.Columns("K:R").Hidden = False
Selection.AutoFilter
With Selection
.AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
End With
Set Rng = ActiveSheet.AutoFilter.Range
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
'' make sure you have more than 1 row to copy ''
Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
If Myval <> "1" Then
Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
Application.CutCopyMode = xlCopy
End If
Case "5£"
Range("A1:d1").Select
ws.Columns("K:R").Hidden = False
Selection.AutoFilter
With Selection
.AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
End With
Set Rng = ActiveSheet.AutoFilter.Range
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
'' make sure you have more than 1 row to copy ''
Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
If Myval <> "1" Then
Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
Application.CutCopyMode = xlCopy
End If
Case Else
'''' Activate Summary and Hide columns '''
Sws.Activate
Sws.Range("A1").Select
Sws.Columns("K:Q").Hidden = True
Exit Sub
End Select
Selection.AutoFilter
End If
ws.Columns("K:R").Hidden = True
Next ws
End Sub