Selected Answer
Lucky man, I didn't even know this would be possible but I found the perfect macro for you.
Sub AutoFilter_All_Sheets()
Dim objSheet As Worksheet, objMainSheet As Worksheet
Dim arrAllFilters() As Variant
Dim byteCountFilter As Byte, i As Byte
Set objMainSheet = ActiveSheet
If insertAllFilters(arrAllFilters, byteCountFilter) Then
Application.ScreenUpdating = False
For Each objSheet In ActiveWorkbook.Worksheets
'Skip the starting sheet
If objSheet.Name <> objMainSheet.Name Then
On Error GoTo errhandler
'check Autofilter, if one is off = switch on
objSheet.Select
objSheet.AutoFilterMode = False 'clear existing filtering
If Not objSheet.AutoFilterMode Then
' if sheet doesn't contain some data
Range(arrAllFilters(4, 1)).AutoFilter
End If
For i = 1 To byteCountFilter
'Only 1 criteria (without Operator)
If arrAllFilters(2, i) = 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i)
'Filter with operator:
ElseIf arrAllFilters(2, i) <> 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i), _
Operator:=arrAllFilters(2, i), _
Criteria2:=arrAllFilters(3, i)
End If
Next i
End If
Next objSheet
Else
For Each objSheet In ActiveWorkbook.Worksheets
If objSheet.Name <> objMainSheet.Name Then
objSheet.Activate
objSheet.AutoFilterMode = False
End If
Next objSheet
If Not objMainSheet.AutoFilterMode Then
'Main Sheet doesn't contain data or Autofilter is off
MsgBox "Sheet (Name """ & objMainSheet.Name & """) doesn't contain data or the Autofilter is off!" _
& vbCrLf & "This code can't continue.", vbCritical, "Missing Autofilter object or filter item"
End If
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
objMainSheet.Activate
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
errhandler:
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
If Err.Number = 1004 Then
MsgBox "Probable cause of error - sheet dosn't contain some data", vbCritical, "Error Exception on sheet " & ActiveSheet.Name
Else
MsgBox "Sorry, run exception"
End If
End Sub
Function insertAllFilters(arrAllFilters() As Variant, byteCountFilter As Byte) As Boolean
' go throught all filters and inserting their address and criterial
Dim myFilter As Filter
Dim myFilterRange As Range
Dim boolFilterOn As Boolean
Dim i As Byte, byteColumn As Byte
Dim x As Variant
boolFilterOn = False: i = 0: byteColumn = 0
' If AutoFilter is off - return False
If Not ActiveSheet.AutoFilterMode Then
insertAllFilters = False
Exit Function
End If
' If Autofilter is on & doesn't filter any item = return false
For Each myFilter In ActiveSheet.AutoFilter.Filters
If myFilter.On Then
boolFilterOn = True
Exit For
End If
Next myFilter
' Check Filter
If Not boolFilterOn Then
insertAllFilters = False
Exit Function
End If
' On Error GoTo errhandler
With ActiveSheet.AutoFilter
For Each myFilter In .Filters
byteColumn = byteColumn + 1
If myFilter.On Then
i = i + 1
ReDim Preserve arrAllFilters(1 To 4, 1 To i)
arrAllFilters(1, i) = myFilter.Criteria1
arrAllFilters(2, i) = myFilter.Operator
On Error Resume Next
x = myFilter.Criteria2
If Err.Number = 0 Then 'Criteria2 exists
On Error GoTo 0 'errorhandler
If myFilter.Operator <> 0 Then
arrAllFilters(3, i) = myFilter.Criteria2
End If
End If
On Error GoTo 0
arrAllFilters(4, i) = .Range.Columns(byteColumn).Cells(1).Address
End If
Next myFilter
End With
byteCountFilter = i
insertAllFilters = True
Set myFilter = Nothing
Set myFilterRange = Nothing
Exit Function
errhandler:
insertAllFilters = False
Set myFilter = Nothing
Set myFilterRange = Nothing
End Function
I tested the above macro and it works. The only thing is that it will try to apply the filter to EVERY worksheet in the workbook.
If you just want this to apply to a specific other worksheet and not the rest of the entire workbook then use this macro (slightly edited from the last version):
Sub AutoFilter_All_Sheets()
Dim objSheet As Worksheet, objMainSheet As Worksheet
Dim arrAllFilters() As Variant
Dim byteCountFilter As Byte, i As Byte
Set objMainSheet = ActiveSheet
'Sheet where you want the filter to work
filter_paste_sheet = "NAME OF YOUR WORKSHEET"
If insertAllFilters(arrAllFilters, byteCountFilter) Then
Application.ScreenUpdating = False
For Each objSheet In ActiveWorkbook.Worksheets
'Skip the starting sheet
If objSheet.Name = filter_paste_sheet Then
On Error GoTo errhandler
'check Autofilter, if one is off = switch on
objSheet.Select
objSheet.AutoFilterMode = False 'clear existing filtering
If Not objSheet.AutoFilterMode Then
' if sheet doesn't contain some data
Range(arrAllFilters(4, 1)).AutoFilter
End If
For i = 1 To byteCountFilter
'Only 1 criteria (without Operator)
If arrAllFilters(2, i) = 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i)
'Filter with operator:
ElseIf arrAllFilters(2, i) <> 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i), _
Operator:=arrAllFilters(2, i), _
Criteria2:=arrAllFilters(3, i)
End If
Next i
End If
Next objSheet
Else
For Each objSheet In ActiveWorkbook.Worksheets
If objSheet.Name = filter_paste_sheet Then
objSheet.Activate
objSheet.AutoFilterMode = False
End If
Next objSheet
If Not objMainSheet.AutoFilterMode Then
'Main Sheet doesn't contain data or Autofilter is off
MsgBox "Sheet (Name """ & objMainSheet.Name & """) doesn't contain data or the Autofilter is off!" _
& vbCrLf & "This code can't continue.", vbCritical, "Missing Autofilter object or filter item"
End If
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
objMainSheet.Activate
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
errhandler:
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
If Err.Number = 1004 Then
MsgBox "Probable cause of error - sheet dosn't contain some data", vbCritical, "Error Exception on sheet " & ActiveSheet.Name
Else
MsgBox "Sorry, run exception"
End If
End Sub
Function insertAllFilters(arrAllFilters() As Variant, byteCountFilter As Byte) As Boolean
' go throught all filters and inserting their address and criterial
Dim myFilter As Filter
Dim myFilterRange As Range
Dim boolFilterOn As Boolean
Dim i As Byte, byteColumn As Byte
Dim x As Variant
boolFilterOn = False: i = 0: byteColumn = 0
' If AutoFilter is off - return False
If Not ActiveSheet.AutoFilterMode Then
insertAllFilters = False
Exit Function
End If
' If Autofilter is on & doesn't filter any item = return false
For Each myFilter In ActiveSheet.AutoFilter.Filters
If myFilter.On Then
boolFilterOn = True
Exit For
End If
Next myFilter
' Check Filter
If Not boolFilterOn Then
insertAllFilters = False
Exit Function
End If
' On Error GoTo errhandler
With ActiveSheet.AutoFilter
For Each myFilter In .Filters
byteColumn = byteColumn + 1
If myFilter.On Then
i = i + 1
ReDim Preserve arrAllFilters(1 To 4, 1 To i)
arrAllFilters(1, i) = myFilter.Criteria1
arrAllFilters(2, i) = myFilter.Operator
On Error Resume Next
x = myFilter.Criteria2
If Err.Number = 0 Then 'Criteria2 exists
On Error GoTo 0 'errorhandler
If myFilter.Operator <> 0 Then
arrAllFilters(3, i) = myFilter.Criteria2
End If
End If
On Error GoTo 0
arrAllFilters(4, i) = .Range.Columns(byteColumn).Cells(1).Address
End If
Next myFilter
End With
byteCountFilter = i
insertAllFilters = True
Set myFilter = Nothing
Set myFilterRange = Nothing
Exit Function
errhandler:
insertAllFilters = False
Set myFilter = Nothing
Set myFilterRange = Nothing
End Function
To use this one, replace NAME OF YOUR WORKSHEET with the worksheet where you want the filtered options to be copied.
Install the macro into a module - here is a tutorial on how to get a macro into Excel.
This macro will not run automatically though. I suggest that you put a small button on the page that allows the user to copy the filter to the other page or a button in the quick access toolbar. Here is a tutorial on how to attach a macro to a button.