Zellen und Spalten ausserhalb Druckbereich löschen

Sub Nur_Druckbereich() Dim Wkb As Workbook Dim Ws As Worksheet Set WkB = ThisWorkbook For Each Ws in Wkb.Worksheets 'Prüfen ob in diesem Worksheet Druckbereich vorhanden 'wenn ja, alle Zeilen und Spalten ausserhalb löschen Next Ws End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Nur_Druckbereich() Dim Wkb As Workbook Dim Ws As Worksheet Set Wkb = ThisWorkbook For Each Ws In Wkb.Worksheets On Error GoTo errorhandler z1 = Range(Ws.PageSetup.PrintArea).Rows(1).Row - 1 z2 = Range(Ws.PageSetup.PrintArea).Rows(1).Row + Range(Ws.PageSetup.PrintArea).Rows.Count s1 = Range(Ws.PageSetup.PrintArea).Columns(1).Column - 1 s2 = Range(Ws.PageSetup.PrintArea).Columns(1).Column + Range(Ws.PageSetup.PrintArea).Columns.Count Ws.Range(Ws.Cells(1, s2), Ws.Cells(1, 256)).EntireColumn.Delete If s1 > 0 Then Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, s1)).EntireColumn.Delete Ws.Range(Ws.Cells(z2, 1), Ws.Cells(65536, 1)).EntireRow.Delete If z1 > 0 Then Ws.Range(Ws.Cells(1, 1), Ws.Cells(z1, 1)).EntireRow.Delete errorhandler: Next Ws End Sub

Hallo Peter. Hier der Code. Gruss Dan.
Option Explicit
Public


Sub Nur_Druckbereich()
On Error GoTo Err_Nur_Druckbereich
Dim Wkb As Workbook
Dim Ws As Worksheet
Dim rngDruckBereich As Range
Set Wkb = ThisWorkbook
For Each Ws In Wkb.Worksheets
'Prüfen ob in diesem Worksheet Druckbereich vorhanden
Set rngDruckBereich = Druckbereich(Ws)
If (Not rngDruckBereich Is Nothing) Then
'wenn ja, alle Zeilen und Spalten ausserhalb löschen
Call AllesAusserhalbDruckbereichLoeschen(rngDruckBereich)
End If
Next Ws
Exit Sub
Err_Nur_Druckbereich:
MsgBox Err.Description, vbCritical, "Error in Nur_Druckbereich"
End Sub

Public


Function Druckbereich(ByRef io_Worksheet As Worksheet) As Range
Dim strDruckBereich As String
Set Druckbereich = Nothing
strDruckBereich = io_Worksheet.PageSetup.PrintArea
On Error Resume Next
Set Druckbereich = io_Worksheet.Range(strDruckBereich)
End Function

Public


Sub AllesAusserhalbDruckbereichLoeschen(ByRef io_rngDruckBereich As Range)
Dim rngCell As Range
For Each rngCell In io_rngDruckBereich.Worksheet.UsedRange.Cells
If (Intersect(rngCell, io_rngDruckBereich) Is Nothing) Then rngCell.Clear
Next rngCell
End Sub

Beliebteste Forumthreads (12 Monate)

Zellen und Spalten ausserhalb Druckbereich löschen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen und Spalten ausserhalb Druckbereich löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread