Wenn Wert in Zelle dann in anderes Tabellenblatt verschieben

[Thomas78]

Hallo liebes Forum,

wieder mal stehe ich vor einem Problem, dass ich trotz Internet- und Forenrecherche noch nicht für mich zum laufen gebracht habe.

Ich habe eine Tankliste in der ich verschiedene Werte eingebe.
Nun bräuchte ich einen Code der mir beim öffnen der Arbeitsmappe (Workbook_open) prüft ob im Arbeitsblatt "Tankliste" in Spalte R ab Zeile 5 ein Kennzeichen eingetragen ist.
Wenn ja soll er :
das Datum aus Spalte Q in das Arbeitsblatt "Daten" in Spalte G
das Kennzeichen aus Spalte R in das Arbeitsblatt "Daten" in Spalte H
die Menge aus Spalte S in das Arbeitsblatt "Daten" in Spalte I
und die Tankstelle aus Spalte T in das Arbeitsblatt "Daten" in Spalte J

verschieben (nicht kopieren)

Alle Daten in denen kein Kennzeichen eingetragen sind sollen in der alten Tabelle verbleiben.

Kann mir hier jemand weiterhelfen?

Vielen Dank und schöne Grüße

Thomas

[Werner.M]

Hallo Thomas,

die Mappe hast du, wir aber nicht, die müssten wir erst nachbauen und das will eigentlich keiner.
Deshalb bitte Beispielmappe hochladen und in deiner Zieltabelle ein paar Daten eintragen, damit man sieht, wie dein Wunschergebnis aussieht.

Gruß Werner

[Thomas78]

Sorry hatte die Datei vergessen.

Im Anhang ist sie jetzt zu finden.

Im Beispiel ist ab Zeile 25 zu sehen dass Kennzeichen eingetragen sind. Diese sollen in die Tabelle unter "Daten" übertragen werden wie im Beispiel dargestellt. Allerdings sollen sie anschließend aus der Tabelle in "Tankliste" gelöscht werden.

Die Formel für die Übersicht in F bis O ändere ich dann natürlich noch ab,

Schöne Grüße

Thomas

[Werner.M]

Hallo Thomas,

deinen kompletten Workbook_open Code durch diesen ersetzen.

Code:

Sub Workbook_Open()
Dim loLetzteQ As Long, loLetzteZ As Long, i As Long

Application.ScreenUpdating = False

With Worksheets("Tankliste")
   loLetzteQ = .Cells(.Rows.Count, 18).End(xlUp).Row
   For i = loLetzteQ To 5 Step -1
       If .Cells(i, 18).Value <> "" Then
           loLetzteZ = Worksheets("Daten").Cells(Worksheets("Daten").Rows.Count, 8).End(xlUp).Row + 1
               If loLetzteZ < 5 Then loLetzteZ = 5
           .Range(.Cells(i, 17), .Cells(i, 20)).Copy _
           Worksheets("Daten").Cells(loLetzteZ, 7)
           .Range(.Cells(i, 17), .Cells(i, 20)).Delete shift:=xlUp
       End If
   Next i
End With


Range("H10").Select
ActiveWorkbook.Worksheets("Termine").ListObjects("Termine_Fahrzeuge").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Termine").ListObjects("Termine_Fahrzeuge").Sort. _
SortFields.Add Key:=Range("Termine_Fahrzeuge[[#All],[Spalte8]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Termine").ListObjects("Termine_Fahrzeuge").Sort
   .Header = xlGuess
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
End With

Application.ScreenUpdating = True
End Sub

Gruß Werner

[Thomas78]

Schönen Guten Morgen Werner,

vielen Dank für deine Hilfe !
Bei den ersten Versuchseingaben funktioniert dein Code wunderbar.
Jetzt heißt es für mich nur noch den Code zu verstehen, aber bei dem momentanen Wetter habe ich dafür wohl genug Zeit.

Schöne Grüße

Thomas