Hallo Excel Freunde !

Ich hoffe ihr Könnt mir bei beinem Problem helfen ! ich bin echt verzeifelt und zwar

ich habe ales mögliche versucht was ich im Netz finden könnte aber leider will es nicht so wie ich es will ! :-) wenn man Excel das erste mal öffnet und das makro startet passt es bei der ersten Zeille danach wenn mann es wiederholt dann funktioniert nichts mehr es findet so qausi nichts mehr ob wohl alles vorhanden ist !

Bsp. ich suche aus tabelle "Spiele" das datum was in der tabelle "Spiele" , in A2 steht in der  aktivierten Tabelle Spalte 1  ; wenn es gefunden wird  soll es von dem gefundenen  datum  ein offsett machen und die offset zellen Kopieren und in die tabelle "DatenNeu" einfügen ; in die und die celle soll es  kopiert werden ! ich hoffe ihr könnt es irgend wie verstehen ! ich weiss, es ist kein excel vba standard ! es soll wirklich so sein !!!  hier ist so Qvasi mein Code  So soll es irgend wie funktionieren  !!!!

Sub Finden()

Dim wk As Workbook, sh0 As Worksheet, sh1 As Worksheet, sh2 As Worksheet
Dim Ergebnis As Range, lngletzte As Long



 Set wk = ActiveWorkbook
 Set sh0 = ThisWorkbook.Worksheets("Spiele")
 Set sh1 = ActiveSheet
 Set sh2 = ThisWorkbook.Worksheets("DatenNeu")
 
    lngletzte = sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1

    ActiveWorkbook.Sheets(ThisWorkbook.Sheets("Spiele").Range("B2").Value).Activate

Set Ergebnis = sh1.Columns(1).find(what:=sh0.Range("A1").Value, _
                LookIn:=xlValues)

If Ergebnis Is Nothing Then
    MsgBox "Leider nichts gefunden" " Hier soll es bitte zum nächsten Datum in Tabelle    " Spiele" springen / Also mit dem Nächsten Datum  Alles von vorne Machen "
Else                     " wenn gefunden den offeset Machen "
    Ergebnis.Offset(3, 3).Copy sh2.Cells(lngletzte, 7)
    Ergebnis.Offset(4, 3).Copy sh2.Cells(lngletzte, 8)
End If
" danach  das datum in der anderen Tabelle suchen un das gleiche machen  "
    ActiveWorkbook.Sheets(ThisWorkbook.Sheets("Spiele").Range("C2").Value).Activate
    
Set Ergebnis = sh1.Columns(1).find(what:=sh0.Range("A1").Value, _
                LookIn:=xlValues)

If Ergebnis Is Nothing Then
    MsgBox "Leider nichts gefunden"  " wie Oben !!! "
Else
    Ergebnis.Offset(3, 3).Copy sh2.Cells(lngletzte, 9)
    Ergebnis.Offset(4, 3).Copy sh2.Cells(lngletzte, 10)
End If

End Sub

Ich hoffe ihr Könnt es irgendwie nach vollziehen was ich meine ! ich Danke euch für eure Zeit  um es irgendwie möglich zu machen !

mfg Sani