Gruppe
Allgemein
Bereich
Bearbeiten
Thema
Alle Zeilen und Spalten außerhalb des benutzten Bereiches löschen
Problem
Alle Zeilen und Spalten unterhalb bzw. rechts von der letzten Zelle mit Wert sollen gelöscht werden.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: Modul1
Sub DeleteRange()
Dim wks As Worksheet
Dim rng As Range
Dim iCounter As Integer
For iCounter = ActiveSheet.Index + 1 To Worksheets.Count
Set wks = Worksheets(iCounter)
Set rng = RealLastCell(wks)
wks.Rows(rng.Row + 1 & ":" & Rows.Count).Delete
wks.Range(wks.Cells(1, rng.Column + 1), _
wks.Cells(1, 256)).EntireColumn.Delete
Next iCounter
End Sub
Function RealLastCell(TheSheet As Worksheet) As Range
Dim ExcelLastCell As Range
Dim Row%, Col%, LastRowWithData%, LastColWithData%
Application.ScreenUpdating = False
Set ExcelLastCell = TheSheet.Cells.SpecialCells(xlLastCell)
LastRowWithData = ExcelLastCell.Row
Row = ExcelLastCell.Row
Do While Application.CountA(TheSheet.Rows(Row)) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row
LastColWithData = ExcelLastCell.Column
Col = ExcelLastCell.Column
Do While Application.CountA(TheSheet.Columns(Col)) = 0 And Col <> 1
Col = Col - 1
Loop
LastColWithData = Col
Set RealLastCell = TheSheet.Cells(Row, Col)
End Function