Zeilen einer Tabelle kopieren

Hallo zusammen,
diese Seite konnte mir bisher einige Male weiterhelfen und konnte hier immer die Lösung finden. Jetzt möchte ich mich doch mit einer Frage an euch wenden.

Ich habe eine dynamische Tabelle (Quelltabelle). In Spalte 1 bis 5 befinden sich Werte und Formeln (Spalte 3 verweist mit einer Formel auf Spalte 2). In Spalte 6 sind den entsprechenden Zeilen Bilder beigefügt, die von ihren Zellposition und -größe unabhängig sind, um die Bilder den Zellen zuzuordnen. Mein Problem besteht darin die sichtbaren Zeilen der Tabelle (wenn diese gefiltert ist) in eine andere dynamische Tabelle (Zieltabelle) auf einem anderen Tabellenblatt zu kopieren.
Von den Spalten 1 bis 5 sollen nur die Werte kopiert werden. Aus Spalte 6 muss der gesamte Zellinhalt kopiert werden, da ja sonst das Bild nicht kopiert wird.

Eine weitere Besonderheit ist (habe ich gelöst, aber hier der Vollständigkeit halber):
Die Zieltabelle ist zu Beginn leer, sprich eine Überschriftenzeile und darunter eine leere Zeile. Deshalb muss, wie im Code zu sehen, erst geprüft werden, ob die erste Zeile leer ist. Wenn ja, dort einfügen, wenn nicht Zeilen zählen und darunter einfügen.


Hier mein bisheriger Code:

Sub KopiereSichtbareZeilenMitBild()
    Dim QuellTabelle As ListObject
    Dim ZielTabelle As ListObject
    Dim QuellZeile As Range
    Dim ZielZeile As Range
    Dim QuellBild As Object
    Dim ZielBild As Object
    Dim Zeile As ListRow
    
    ' Setze die Quelltabelle
    Set QuellTabelle = Sheets("Quelltabelle").ListObjects("Tabelle1")
    
    ' Setze die Ziel Tabelle
    Set ZielTabelle = Sheets("Zieltabelle").ListObjects("Tabelle2")
    
    ' Überprüfe, ob die Quelltabelle Daten enthält
    If QuellTabelle.ListRows.Count  1 Then
        MsgBox "Die Quelltabelle enthält keine Daten.", vbInformation
        Exit Sub
    End If
    
    ' Kopiere die sichtbaren Zeilen
    For Each Zeile In QuellTabelle.ListRows
        If Zeile.Range.EntireRow.Hidden = False Then
            Set QuellZeile = Zeile.Range
             ' Überprüfen, ob die Zieltabelle leer ist
        If ZielTabelle.Range(2, 1) = "" Then
            ' Füge die Quellzeile in die erste Zeile der Zieltabelle ein
            QuellZeile.Copy Destination:=ZielTabelle.Range(2, 1)
        Else
            ' Füge für jede kopierte Zeile eine neue Zeile in der Zieltabelle hinzu und kopiere die Daten
            Set ZielZeile = ZielTabelle.ListRows.Add.Range
            QuellZeile.Copy Destination:=ZielZeile
        End If
            
            Application.CutCopyMode = False
        End If
    Next Zeile
    
    ZielTabelle.Parent.Activate
    
End Sub