Code funktioniert nur im Einzelschritt korrekt
19.06.2018 22:31:03
EasyD
wer kann mir mit meinem Problem mal wieder die Augen öffnen?
Ich importiere csv-Daten auf ein Blatt (Roh_DB) und möchte diese importierten Daten dann auf ein anderes Blatt kopieren. Genauer gesagt geht es hier um Bankumsätze aus dem Online-Banking. Das Ganze für 2 unterschiedliche Konten, ich muss daher entscheiden welche Daten ich gerade importiert habe und abhängig davon auf welches Blatt ich dann kopiere (DB_00 oder DB_05).
Das Kopieren soll unter der Voraussetzung laufen, dass ich NICHT ALLE importierten Daten kopiere, sondern nur ab der Zeile die das nächst höhere Datum als aus dem letzten Kopiervorgang aufweist (ich mache das importieren und kopieren immer wieder und ergänze so sukzessive die Daten).
Damit ich weiß ab welchem Datum ich kopieren muss, errechne ich in den Zellen V1 bzw V2 aus den zuvor importierten csv-Datum das entsprechende Datum (variable datum_DB), die andere Variable ist das letzte Datum aus dem letzten Import (datum_maxDB).
Der Import läuft in einem anderen Code, der Code unten betrifft nur das Kopieren.
Sub copy_DB()
Dim zelles As Range
Dim bereichs As Range
Dim datum_DB As Date
Dim datum_maxDB As Date
If Sheets("Roh_DB").Range("T2").Value = "DB05 ausgewählt" Then
datum_DB = Sheets("Roh_DB").Range("V1").Value 'Startdatum_DB für das kopieren der DB05
datum_maxDB = Sheets("Roh_DB").Range("X1").Value 'MaxDatum für die MsgBox
Else
datum_DB = Sheets("Roh_DB").Range("V2").Value 'Startdatum_DB für das kopieren der DB00
datum_maxDB = Sheets("Roh_DB").Range("X2").Value 'MaxDatum für die MsgBox
End If
Set bereichs = Sheets("Roh_DB").Range("A:A")
Set zelles = bereichs.Find(what:=datum_DB, lookat:=xlWhole, LookIn:=xlValues)
Sheets("Roh_DB").Activate
'zuerst nach datum_DB sortieren
With ActiveWorkbook.Worksheets("Roh_DB").Sort
.SetRange Range("A1:R10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Wenn das letzte importierte datum_DB in den Rohdaten nicht gefunden wird:
If zelles Is Nothing Then
MsgBox "Fehler! Die csv-Daten aus dem Online-Banking müssen die Umsätze ab dem " & datum_DB & " _
enthalten!", vbOKOnly, "csv-Daten prüfen!"
Exit Sub
Else
If zelles >= datum_DB Then '= Zelle in Spalte A auf dem Blatt Roh_DB mit dem nächst höhren _
Datum
'ab dort kopieren
Range(Cells(zelles.Row, 1), Cells(zelles.Row, 18)).Select
Range(Selection, Selection.End(xlDown)).Copy
If Sheets("Roh_DB").Range("T2").Value = "DB05 ausgewählt" Then
'und auf dem jeweiligen Blatt einfügen
Sheets("DB_05").Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:= _
xlValues
Else
Sheets("DB_00").Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:= _
xlValues
End If
Application.CutCopyMode = False 'Zwischenspeicher löschen
Else
MsgBox "Fehler! In den csv-Daten aus dem Online-Banking ist kein Umsatz nach dem " & _
datum_maxDB & " enthalten!", vbOKOnly, "csv-Daten prüfen!" 'xxxxxxxxxxxx hier hakt es xxxxxxxxxxxx
End If
End If
Sheets("Roh_DB").Range("A2:R1048576").ClearContents
End Sub
Und um es noch merkwürdiger zu machen - im Einzelschritt läuft der Code prima und wie gewollt durch, nur die gesamte Prozedur hängt an der MsgBox.
Wer kann das Brett vor meinem Kopf entfernen?
Ist "zelles >= datum_DB" das Problem? Wenn ja, warum geht es im Einzelschritt?
Ich bin verwirrt......
Ich würde die Mappe auch hochladen, aber meinen Kontostand möchte ich ungern ins Netz laden ;)
Achja... PowerQuery ist leider keine Option....
Dank euch!