VBA - Filter data, copy only visible cells after filter and move onto next filter if no data.

RAM98988 

Okay, please give this a try.

And if that takes care of your original question, please take a minute to accept the post with the provided solution as a Best Response to mark your question as Solved.

Sub FilterAndCopy()
Dim wsData      As Worksheet
Dim dws         As Worksheet
Dim lr          As Long
Dim x           As Variant
Dim dict        As Object
Dim it          As Variant
Dim i           As Long
Dim dlr         As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")
lr = wsData.Cells(Rows.Count, "A").End(xlUp).Row

wsData.AutoFilterMode = False

x = wsData.Range("A2:A" & lr).Value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    dict.Item(x(i, 1)) = ""
Next i

For Each it In dict.keys
    On Error Resume Next
    Set dws = Worksheets(CStr(it))
    On Error GoTo 0
    If dws Is Nothing Then
        Set dws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        dws.Name = it
    End If
    
    With wsData.Range("A1").CurrentRegion
        .AutoFilter field:=1, Criteria1:=it
        dlr = dws.Cells(Rows.Count, "A").End(xlUp).Row
        If dws.Range("A1").Value <> "" Then dlr = dlr + 1
        wsData.Range("C2:I" & lr).SpecialCells(xlCellTypeVisible).Copy dws.Range("A" & dlr)
        .AutoFilter
    End With
    Set dws = Nothing
Next it

Application.ScreenUpdating = True
End Sub