Alles außer Druckbereich löschen
21.01.2016 19:15:36
Dennis
erst einmal herzlichen Dank im Voraus - das Forum hier UND DIE USER sind spitze.
Ich möchte in einer Tabelle alles außer den festgelegten Druckbereich löschen, und das in mehreren Tabellenblättern.
Leider erhalte ich einen Fehler, sobald in dem zu löschendem Bereich verbundene Zellen existieren.
Kennt hier jemand eine Lösung?
Vielen Dank im Voraus,
euer Dennis.
Sub Saeubern() '2016-01-21, Script von Dennis
'Alles außerhalb des gültigen Druckbereiches löschen
Dim Zelle As Range
Sheets("Dezember").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.Clear 'Contents
Next Zelle
Sheets("November").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$56"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.Clear 'Contents
Next Zelle
Sheets("Oktober").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.Clear 'Contents
Next Zelle
Sheets("September").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$59"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("August").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("Juli").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("Juni").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("Mai").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("April").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("März").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("Februar").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AD$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
Sheets("Januar").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, Range("Print_Area")) Is Nothing Then _
Zelle.ClearContents
Next Zelle
End Sub
Anzeige