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
Columns("B").ClearContents
For i = 1 To ActiveWorkbook.Sheets.Count - 1 Step 1
Sheets(i).Range("C122:C218").Copy
Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next i
j = Cells(Rows.Count, "B").End(xlUp).Row 'Zeilenzahl ermitteln
Range("B1:B" & j).SpecialCells(xlCellTypeBlanks).Delete 'Leerzellen aufrücken
For i = 1 To ActiveWorkbook.Sheets.Count - 1 Step 1
Sheets(i).Range("M122:M218").Copy
Cells(Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next i
j = Cells(Rows.Count, "C").End(xlUp).Row 'Zeilenzahl ermitteln
Range("C1:C" & j).SpecialCells(xlCellTypeBlanks).Delete 'Leerzellen aufrücken
For i = 1 To ActiveWorkbook.Sheets.Count - 1 Step 1
Sheets(i).Range("K122:K218").Copy
Cells(Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next i
j = Cells(Rows.Count, "D").End(xlUp).Row 'Zeilenzahl ermitteln
Range("D1:D" & j).SpecialCells(xlCellTypeBlanks).Delete 'Leerzellen aufrücken
Fehler:
Application.EnableEvents = True
Application.ScreenUpdating = True
Range("A1").Select
ActiveSheet.UsedRange
End Sub
in diesem VBA-Code verbirgt sich ein Fehler.
Folgendes soll er erfüllen:
Der Code kopiert mir auf das letzte Blatt im Workbook alle Zeilen "M122-M218" und "K122-K218" der anderen enthaltenen Arbeitsblätter nebereinander und untereinander (in Spalte B und C).
Im laufenden Betrieb habe ich jedoch feststellen müssen, das folgender Fehler auftritt:
In die Spalte C werden nur teilweise die Daten übernommen, bei neu eingepflegten Daten entsteht keine Eintragung, obwohl der Wert in B kopiert wurde.
Die Spalte D wird gar nicht gefüllt.
Kann einer den Fehler in diesem Code finden und berichtigen?
Wenn jemand eine andere Lösung hat, nehme ich die auch gerne, leider kenne ich mich mit VBA nicht aus :(
Danke für eure Unterstützung.
LG
Sascha