Option Explicit
Sub Umbruch()
On Error GoTo Fehler
Dim SP%, ZE&, LR&, Zelle As Range, Pos%
Application.ScreenUpdating = False
SP = 84 'Spalte CF
ZE = 1 'ab Zeile 1 ggf Überschrift beachten
With ActiveSheet
LR = .Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For Each Zelle In .Columns(SP).SpecialCells(xlCellTypeConstants, 3)
Pos = InStrRev(Zelle, "1")
Zelle = Left(Zelle, Pos) & vbLf & Mid(Zelle, Pos + 1)
Next
End With
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Option Explicit
Sub Umbruch()
On Error GoTo Fehler
Dim SP%, ZE&, LR&, Zelle As Range, Pos%
Application.ScreenUpdating = False
SP = 84 'Spalte CF
ZE = 2 'ab Zeile 2 ggf Überschrift beachten
With ActiveSheet
LR = .Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For Each Zelle In .Columns(SP).SpecialCells(xlCellTypeConstants, 3)
If Zelle.Row >= ZE Then
Pos = InStrRev(Zelle, "1")
Zelle = Left(Zelle, Pos) & vbLf & Mid(Zelle, Pos + 1)
End If
Next
End With
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Sub Umbruch()
On Error GoTo Fehler
Dim SP%, LR&
Application.ScreenUpdating = False
SP = 84 'Spalte CF
With ActiveSheet
.ResetAllPageBreaks
If .AutoFilterMode Then .AutoFilterMode = False
.Columns(SP).AutoFilter Field:=1, Criteria1:="1"
LR = .Cells(Rows.Count, SP).End(xlUp).Row
.AutoFilterMode = False
.HPageBreaks.Add before:=Rows(LR + 1)
End With
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen