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
|