Daten aus Tabelle filtern und übertragen

https://www.herber.de/bbs/user/159492.xlsx

Hallo,
ich beiße mir gerade an folgendem Problem die Zähne aus.
Wie in der Datei im Reiter Ausgang befinden sich meine Daten in einer Tabelle die Horizontal verläuft. Die Spalte B, habe ich nur zur Erläuterung eingefügt in richtigen Material existiert diese nicht.
Im Ersten Schritt muss natürlich abgeklärt werden ob das Jahr Reiter Ausgang-A1, schon eingetragen ist.

Sub DurchsuchenUndEinfügen2()
Dim WertSuchen As String
    Dim Suchbereich As Range
    Dim Zelle As Variant
    
    ' Wert zum Suchen aus Ausgang
    WertSuchen = Sheets("Ausgang").Range("A1").Value
    
    ' Suchbereich in Zeile 5 von DiagrammDaten
    lsp = Sheets("DiagrammDaten").Cells(5, Columns.Count).End(xlToLeft).Column
    Set Suchbereich = Sheets("DiagrammDaten").Range("A5").Resize(1, lsp)
    
    ' Durchsuche den Suchbereich nach dem Wert
    For Each Zelle In Suchbereich
        ' Überprüfe, ob der Wert gefunden wurde
            If Zelle = WertSuchen Then MsgBox "Gefunden": Exit Sub
    Next Zelle
    
   ' Einfüge des Werts in die erste freie Zelle in Zeile 2
   lsp = Sheets("DiagrammDaten").Cells(5, 1).End(xlToRight).Column + 1
   If lsp > Columns.Count Then lsp = 1  'Korrektur 1.Spalte
   Sheets("DiagrammDaten").Cells(5, lsp).Value = WertSuchen
   MsgBox "Eingetragen"
End Sub

Sub ListenVergleichenUndEinfügen()
    Dim ws1 As Worksheet ' Arbeitsblatt für Liste 1
    Dim ws2 As Worksheet ' Arbeitsblatt für Liste 2
    Dim letzteZeile1 As Long ' letzte Zeile in Liste 1
    Dim letzteZeile2 As Long ' letzte Zeile in Liste 2
    Dim i As Long ' Zähler für Schleife
    
    ' Arbeitsblätter festlegen
    Set ws1 = ThisWorkbook.Sheets("Liste")
    Set ws2 = ThisWorkbook.Sheets("DiagrammDaten")
    
    ' Letzte Zeile in Liste 1 ermitteln
    letzteZeile1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    
    ' Letzte Zeile in Liste 2 ermitteln
    letzteZeile2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    
    ' Schleife zum Vergleichen und Einfügen der fehlenden Elemente
    For i = letzteZeile2 To 4 Step -1
        ' Überprüfen, ob Element aus Liste 2 in Liste 1 vorhanden ist
        If WorksheetFunction.CountIf(ws1.Range("A6:A" & letzteZeile1), ws2.Cells(i, 1).Value) = 0 Then
            ' Fehlendes Element an das Ende von Liste 1 einfügen
            letzteZeile1 = letzteZeile1 + 1
            ws1.Cells(letzteZeile1, 1).Value = ws2.Cells(i, 1).Value
        End If
    Next i
    
    MsgBox "Vergleich und Einfügevorgang abgeschlossen."
End Sub