Office: Frage zu Makro; Blätter auslesen und unterein. in T kopieren

Hallo,
ich bekam vor einiger Zeit eine Anweisung von Schatzi, welche mir in allen Tabellenblättern, die mit "2008-" anfangen, gewisse Zeilen ausließt/kopiert und in aktuelles, geöffnetes Tabellenblatt untereinander einfügt.
Mußte die Anweisung an neue Gegebenheiten anpassen und ich vermute, dass etwas nicht stimmt.

Hier Ergebnis meines Hexenwerks:

Private Sub Worksheet_Activate()
Dim ws As Worksheet, i As Long
'Schalte die automatische Berechnung vorübergehend ab:
Application.Calculation = xlCalculationManual
'Leere den Zielbereich:
Range("O5:BM65536").Clear
'Durchlaufe alle Blätter
For Each ws In ThisWorkbook.Worksheets
'Fängt der Name richtig an?
If Left(ws.Name, 5) = "2008-" Then
'Kopiere den Bereich C3:BAxx...:
ws.Range("C3:BA" & ws.Range("C65536").End(xlUp).Row).Copy
'...und füge ihn ab Spalte O ein:
Cells(WorksheetFunction.Max(5, Range("O65536").End(xlUp).Row + 1), 15).PasteSpecial Paste:=xlValues
End If
Next ws
'Durchsuche Spalte O nach Leerzeilen und lösche sie:
For i = Range("O65536").End(xlUp).Row To 6 Step -1
If IsEmpty(Cells(i, 15)) Then Range(Cells(i, 15), Cells(i, 43)).Delete Shift:=xlShiftUp
Next i
'Schalte die automatische Berechnung wieder ein:
Application.Calculation = xlCalculationAutomatic
End Sub

Folgendes:

-Das Auslesen der Blätter, die mit "2008-" anfangen, bleibt erhalten!
-Der Bereich, der ausgelesen werden soll, ist C3:BA bis Spaltenende
-Geschrieben wird das Ergebnis in O5:BM bis Spaltenende
-Dieses Makro schreibt jedoch ins aktuelle Tabellenblatt zwischen zwei ausgelesenen Positionen jede Menge Leerzeilen ( über 100!!)

Hätte gerne, das die Ergebnisse in O5:BM bis Spaltenende ohne Leerzeichen untereinander geschrieben werden ( zwecks Durchscrollen ).

Vielleicht findet von Euch jemand den Fehler in der Anweisung?

Gruß Timi

 

Hallo!

ALso hab das mal bei mir ausprobier, bei mir geht es. Hast den Code auch im richtigen Tabellenblatt?

Gruß

 

Hallo!

Ich kann eigentlich auch nichts gravierendes erkennen.
Hier müsste vielleicht noch nachgearbeitet werden:

If IsEmpty(Cells(i, 15)) Then Range(Cells(i, 15), Cells(i, 43)).Delete Shift:=xlShiftUp

Die Spalte BM hat nicht die Nummer 43 sondern die Nummer 65.
Außerdem solltest du testen, ob die Zellen in Spalte O wirklich leer sind, oder einfach nur leer scheinen.