Hallo,

vielleicht hilft Dir ja dieser VBA-Code weiter?

Sub CopyData()
    Dim sh As Worksheet, nwSh As Worksheet
    Dim rng As Range, rngFlt As Range
    Dim copied() As String
    Dim strValue As String
    Dim lRwInsert As Long
    Set sh = ThisWorkbook.Worksheets("Quelle")
    
    For Each rng In sh.UsedRange.Rows
        If rng.Row > 1 Then
            strValue = rng.Cells(1, 2).Value
            If Not arrayValueExists(copied, strValue) Then
                ReDim Preserve copied(myUBound(copied) + 1)
                copied(myUBound(copied)) = strValue
                Set nwSh = ThisWorkbook.Worksheets.Add()
                nwSh.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                nwSh.Name = strValue
                nwSh.Cells(1, 1) = sh.Cells(1, 1)
                nwSh.Cells(1, 2) = sh.Cells(1, 2)
                ' Filter Data
                sh.AutoFilterMode = False
                With sh.Range("A1:B1")
                    .AutoFilter
                    .AutoFilter field:=2, Criteria1:=strValue
                    lRwInsert = 2
                    For Each rngFlt In sh.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
                        If rngFlt.Cells(1, 1) <> "" Then
                            nwSh.Cells(lRwInsert, 1) = rngFlt.Cells(1, 1)
                            nwSh.Cells(lRwInsert, 2) = rngFlt.Cells(1, 2)
                            lRwInsert = lRwInsert + 1
                        End If
                    Next
                End With
                sh.AutoFilterMode = False
            
            End If
        End If
    Next
    
End Sub


Function myUBound(arr() As String) As Long
    On Error Resume Next
    myUBound = -1
    myUBound = UBound(arr)
    If Not Err.Number = 0 Then
        Err.Clear
    End If
End Function

Function arrayValueExists(arr() As String, findValue As String) As Boolean
    Dim lCnt As Long
    arrayValueExists = False
    For lCnt = 0 To myUBound(arr)
        If arr(lCnt) = findValue Then
            arrayValueExists = True
            Exit For
        End If
    Next
End Function

Kurze Erläuterung:

Der Befehl "CopyData" durchläuft in der Tabelle "Quelle" alle Einträge ab der zweiten Zeile.

Das Array "copied" enthält alle bereits gefundenen Einträge, die bereits kopiert worden sind. Falls ein Neuer Eintrag gefunden wurde, wird eine neue Tabelle angelegt und die gefundenen Einträge unter verwendung von AutoFilter  kopiert.

LG, BigBen