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

RAM98988 

Please give this a try and let me know if you get the desired output.

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

Application.ScreenUpdating = False

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

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))
    dws.Cells.Clear
    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
        wsData.Range("C2:I" & lr).SpecialCells(xlCellTypeVisible).Copy dws.Range("A1")
        .AutoFilter
    End With
    Set dws = Nothing
Next it

Application.ScreenUpdating = True
End Sub

Please click the button called "Filter And Copy" on Sheet1 in the attached to run the code.