Greeting to all.
I hope someone can help up on this. I would like to copy filtered data to another work sheet with VBA.
I have got the below scripts that work very fine on Excel 2010. However, when I run this with Excel 2007,
it shows "The Special Limit of 8,192 areas has been exceeded for the filtered Value"

My raw data record is about 9.5K row. However the filtered data is just around 80 row.
Appreacite your help very much.


Sub CopyFilteredData()

'Declare the variables
Dim wksDest As Worksheet
Dim rngFilt As Range
Dim CellCount As Long
Dim Msg As String

'If the data has not been filtered with the AutoFilter, exit the sub
With ActiveSheet
If .AutoFilterMode = False Or .FilterMode = False Then
MsgBox "Please filter the data with the AutoFilter, and try again!"
Exit Sub
End If
End With

'Set the destination worksheet
Set wksDest = Worksheets("Filtered Part List")

'Clear the destination worksheet
wksDest.Cells.Clear

With ActiveSheet.AutoFilter.Range

'For Excel 2007 and earlier, check for the SpecialCells limitation
If Val(Application.Version) < 14 Then

On Error Resume Next
CellCount = .Columns(1).SpecialCells(xlCellTypeVisible) _
.Areas(1).Cells.Count
On Error GoTo 0

If CellCount = 0 Then
Msg = "The SpecialCells limit of 8,192 areas has been "
Msg = Msg & vbNewLine
Msg = Msg & "exceeded for the filtered value."
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & "Tip: Sort the data, and try again!"
MsgBox Msg, vbExclamation, "SpecialCells Limitation"
GoTo ExitTheSub
End If

End If

'Set the filtered range
On Error Resume Next
Set rngFilt = .Resize(.Rows.Count - 1).Offset(1, 0) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'Copy the filtered data to the destination worksheet
If Not rngFilt Is Nothing Then
rngFilt.Copy Destination:=wksDest.Range("A2")
Else
MsgBox "No records are available to copy...", vbExclamation
End If

End With

ExitTheSub:

'Clear the filter
ActiveSheet.ShowAllData

End Sub