VBA-Datenübernahme schlägt fehl
Sascha
in einer Datenbank nutze ich zum Auflisten aller gespeicherten Datensätze folgenden VBA-COde:
Private Sub Worksheet_Activate()
'Zielblatt muss immer die höchste Nr. haben!
Dim i As Long
Dim j As Long
On Error GoTo Fehler
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
ActiveSheet.Columns("C").ClearContents
ActiveSheet.Columns("D").ClearContents
ActiveSheet.Columns("E").ClearContents
ActiveSheet.Columns("F").ClearContents
ActiveSheet.Columns("G").ClearContents
ActiveSheet.Columns("H").ClearContents
ActiveSheet.Columns("AA").ClearContents
ActiveSheet.Columns("AB").ClearContents
With ActiveSheet
For i = 1 To ActiveWorkbook.Sheets.Count - 1 Step 1
Sheets(i).Range("C206:C386").Copy
.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("N206:N386").Copy
.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("L206:L386").Copy
.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("I206:I386").Copy
.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("J206:J386").Copy
.Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("G4:G184").Copy
.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("D206:D386").Copy
.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(i).Range("V209:V380").Copy
.Cells(Rows.Count, "AA").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete xlUp
On Error GoTo Fehler
Sheets(i).Range("W209:W380").Copy
.Cells(Rows.Count, "AB").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete xlUp
On Error GoTo Fehler
Sheets(i).Range("AC209:AC380").Copy
.Cells(Rows.Count, "AC").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete xlUp
On Error GoTo Fehler
Next i
End With
Fehler:
Application.CutCopyMode = False
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveSheet.Range("A1").Select
End Sub
Dieser Code kopiert mir alle notwendigen Daten aus den Spalten der Arbeitsblätter in das letzte Arbeitsblatt der Mappe und listet mir diese untereinander auf.
Bisher ging das soweit ganz gut.
Als ich den aktuellen Datensatz einpflegen wollte, wirft er mir aber nur noch die Daten aus dem ersten Arbeitsblatt der Mappe aus, die anderen werden gekonnt ignoriert.
Da ich mich mit VBA leider gar nicht auskenne hier die Frage an euch, woran das liegen kann.
Am Format der Quelldaten hat sich nichts geändert, wenn ich andere Daten eintrage (z.B. Daten die bereits in der Datenbank vorhanden sind), kommt das gleiche Problem.
Hat jemand eine Idee für mich?
Vielen Dank für eure Hilfe,
Sascha
Anzeige