Letzte Zelle zurücksetzen/Arbeitsmappe verkleinern
20.09.2015 12:13:05
erichm
ich habe diverse Arbeitsmappen, die ich mal in größerem und mal in kleinerem Umfang nutzen muss. Dabei geht es meist um Formeln die kopiert bzw. gelöscht werden.
Beim löschen "merkt sich EXCEL" aber trotzdem die "letzte Zelle der Arbeitsmappe" die mit einer Formel gefüllt war. Bei zig-tausenden Zeilen und vielen Spalten wird das immer zum Problem wenn ich irgendwann Spalten einfügen muss (Ressourcen nicht ausreichend).
Um das zu lösen habe ich im Netz folgenden Code gefunden, der die "letzte Zelle zurücksetzt":
Public Sub ResetLastCell()
' Diese Prozedur setzt die letzte Zelle des aktiven Tabellenblattes zurück
' Original-Code: Microsoft Corporation
' Anpassungen: Philipp von Wartburg
Dim rngLastCell As Range
Dim rowstep As Integer
Dim colstep As Integer
'Aktuelle letzte Zelle des aktiven Blattes merken
Set rngLastCell = Cells.SpecialCells(xlLastCell)
'Adresse der aktuellen letzten Zelle in der Statusleiste anzeigen
Application.StatusBar = "Letzte Zelle: " & rngLastCell.Address
'Variablen rowstep und colstep initialisieren
rowstep = -1
colstep = -1
'Schleife durchlaufen bis letzte Zelle gefunden oder Zelle A1 erreicht ist
While (rowstep + colstep 0) And (rngLastCell.Address "$A$1")
'Prüfen ob die momentane Spalte eine Zelle mit Daten enthält
If Application.CountA(Range(Cells(1, rngLastCell.Column), rngLastCell)) > 0 Then _
colstep = 0
'Prüfen ob die momentane Zeile eine Zelle mit Daten enthält
If Application.CountA(Range(Cells(rngLastCell.Row, 1), rngLastCell)) > 0 Then _
rowstep = 0
'Objektpointer rngLastCell auf die neue Position setzen
Set rngLastCell = rngLastCell.offset(rowstep, colstep)
'Adresse der "neuen" letzten Zelle in der Statusleiste anzeigen
Application.StatusBar = "Letzte Zelle: " & rngLastCell.Address
Wend
'Unbenutzte Spalten leeren und dann löschen
With Range(Cells(1, rngLastCell.Column + 1), "IV65536")
Application.StatusBar = "Lösche Spalten: " & .Address
.Clear
.Delete
End With
'Unbenutzte Zeilen leeren und dann löschen
With Rows(rngLastCell.Row + 1 & ":65536")
Application.StatusBar = "Lösche Zeilen: " & .Address
.Clear
.Delete
End With
Set rngLastCell = Nothing
'Neue letzte Zelle selektieren
Cells.SpecialCells(xlLastCell).Select
'Statusleiste zurücksetzen und neue letzte Zelle ausgeben
Application.StatusBar = False
MsgBox "Die neue letzte Zelle besitzt die Adresse " & _
Cells.SpecialCells(xlLastCell).Address(False, False) & ".", vbInformation
End Sub
Also habe ich mir folgendes überlegt:
Ich mache das löschen der unnötigen Zeilen etappenweise. Dazu habe ich mir einen Code aufgezeichnet, der wie folgt angepasst werden müsste:
Sub verkleinern()
Cells.SpecialCells(xlLastCell).Select 'hier wird die "letzte Zelle" ermittelt; hier mit Beispiel "Zeile 65000"
Rows("64001:65000").Select 'jetzt müsste diese Range automatisch mit den letzten 1000 Zeilen selektiert werden
Selection.Delete Shift:=xlUp
ActiveWorkbook.Save
End Sub
Dann kann ich den Code mehrmals durchlaufen lassen, bis ich bei der zuletzt zu löschenden Zeile angekommen bin (z.B. Zeile 100).
Besten Dank für eine Hilfe!
mfg