Was ist an diesem VBA-Code falsch?
23.11.2008 15:55:00
Heiko31
ich möchte mit folgenden Code die Inhalte der Zeilen C122:C218 / M122:M218 / K122:K218 aus allen Arbeitsblättern in die Spalten B / C / D auf dem letzten Tabellenblatt übernehmen.
Die ersten beiden funktionieren wunderbar, aber die Auflistung aus K122:218 funktioniert gar nicht sprich er übernimmt mir hier keinen einzigen Wert.
Wer kann mir helfen?
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