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