Option Explicit
Sub ScrollBalkenAufBenutztenBereichReduzieren()
'alle Spalten und Zeilen ausserhalb des benutzten Bereichs werden gelöscht.
'Der benutzte Bereich ist der Bereich,der Formeln oder Werte enthält
Dim l_LastRow As Long, l_LastCol As Long
Dim l_LastRowFormel As Long, l_LastColFormel As Long
Dim l_LastRowWert As Long, l_LastColWert As Long
Dim l_RealLastRow As Long, l_RealLastCol As Long
Dim l_c As Long, l_r As Long, c As Long
Dim ws As Worksheet
Set ws = ActiveSheet
->Zeile/Spalte des angeblich benutzten Bereichs
l_LastRow = ActiveSheet.UsedRange.Rows.Count
l_LastCol = ActiveSheet.UsedRange.Columns.Count
->Zeile/Spalte der letzten Formel bestimmen
Call ZeileSpalte_letzteFormel(ws, l_LastRowFormel, l_LastColFormel)
->Zeile/Spalte des letzten Wertes bestimmen
Call ZeileSpalte_letzterWert(ws, l_LastRowWert, l_LastColWert)
l_RealLastRow = Application.WorksheetFunction _
.Max(l_LastRowFormel, l_LastRowWert)
l_RealLastCol = Application.WorksheetFunction _
.Max(l_LastColFormel, l_LastColWert)
->auf tatsächlich benutzte Zeilen reduzieren
->Korrektur von klexy :-) nur löschen, wenn nicht alles i.O. ist
If l_RealLastRow <> l_LastRow Then
ws.Rows(l_RealLastRow + 1 & : & l_LastRow).Delete
End If
->auf tatsächlich benutzte Spalten reduzieren
For c = l_LastCol To l_RealLastCol + 1 Step -1
ws.Columns(c).EntireColumn.Delete
Next
ws.Cells(1, 1).Select
ws.Cells(l_RealLastRow, l_RealLastCol).Select
->notwendig, damit Strg+Ende richtig reagiert
l_LastRow = ActiveSheet.UsedRange.Rows.Count
l_LastCol = ActiveSheet.UsedRange.Columns.Count
End Sub
'*************************************************************
Private Sub ZeileSpalte_letzteFormel( _
ws As Worksheet, Zeile As Long, Spalte As Long)
->bestimmt die Zeile und Spalte der letzten Formel
->auf dem Arbeitsblatt
Dim zelle As Range, l_r As Long, l_c As Long
Zeile = 0: Spalte = 0
On Error GoTo ErrorHandler
For Each zelle In ws.Cells.SpecialCells(xlCellTypeFormulas)
->adr = zelle.Address
If Zeile < zelle.Row Then Zeile = zelle.Row
If Spalte < zelle.Column Then Spalte = zelle.Column
Next
->Zeile = ws.Range(adr).Row: Spalte = ws.Range(adr).Column
Exit Sub
ErrorHandler:
Err.Clear->keine Formel vorhanden
End Sub
'*************************************************************
Private Sub ZeileSpalte_letzterWert(ws As Worksheet, _
Zeile As Long, Spalte As Long)
->bestimmt die Zeile und Spalte des letzten Wertes
->auf dem Arbeitsblatt
Dim l_r As Long, l_c As Long, l_LastRow As Long, l_LastCol As Long
l_LastRow = ActiveSheet.UsedRange.Rows.Count
l_LastCol = ActiveSheet.UsedRange.Columns.Count
Zeile = 0: Spalte = 0
For l_c = 1 To l_LastCol
l_r = ws.Cells(ws.Rows.Count, l_c).End(xlUp).Row
->größte Zeilennummer merken
If Zeile < l_r Then
If l_r > 1 Then
Zeile = l_r
ElseIf ws.Cells(l_r, l_c).Value <> Then Zeile = l_r
End If
End If
->Spalte merken, wenn nicht leer
If l_r > 1 Or ws.Cells(l_r, l_c).Value <> Then Spalte = l_c
Next
End Sub