Zeilenumbruch wenn Wert sichtbar

Hallo Zusammen
Ich möchte immer wenn in der Spalte K "*****" steht, einen manuellen Seitenumbruch einfügen. Nun habe ich das Problem, dass auch versteckte Zeilen berücksichtigt werden. Ich möchte den Zeilenumbruch nur bei sichtbaren Zeilen.
Ich habe das Ganze versucht mit ".EntireRow.Hidden Then" oder mit "Loop While Rows(ActiveCell.Row).Hidden" zu lösen, aber komme einfach nicht drauf wie es funktionieren könnte.
Vermutlich mache ich als Anfänger ganz grundlegende Fehler...
Dies ist die Grundversion die Funktioniert.


Sub Seitenumbruch()
Dim L As Long
Application.ScreenUpdating = False
For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(L, 11).Value = "*****" Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(L, 11)
End If
Next
Application.ScreenUpdating = True
End Sub

>
Dies ist mein Lösungsansatz der nicht funktioniert 1:


Sub Seitenumbruch_mit_hidden()
Dim L As Long
Application.ScreenUpdating = False
For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If .Rows(L).EntireRow.Hidden Then
' If Cells(L, 11).Value = "*****" Then
Else
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(L, 11)
End If
Next
Application.ScreenUpdating = True
End Sub


Sub Seitenumbruch_mit_loop()
Dim L As Long
Application.ScreenUpdating = False
Do
Loop While Rows(ActiveCell.Row).Hidden
For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(L, 11).Value = "*****" Then
Cells(L, 11).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
Next
Application.ScreenUpdating = True
End Sub

>
Besten Dank für die Hilfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Seitenumbruch2() Dim LastRow As Long Dim Zelle As Range LastRow = Cells(Rows.Count, 11).End(xlUp).Row Application.ScreenUpdating = False For Each Zelle In Range("K1:K" & LastRow).SpecialCells(xlVisible) If Zelle.Value = "*****" Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Zelle End If Next Application.ScreenUpdating = True End Sub

Hallo Peter
Besten Dank! Deine Lösung hat isoliert ohne weiteres funktioniert. Ich habe sie nun in einen grösseren Befehl eingefügt, bei dem mit den ausgewählten Werten ein automatisches PDF erstellt wird und im Anschluss alles wieder zurückgesetzt wird. Damit ich beim nächsten PDF erstellen nicht noch alte Zeilenumbrüche habe. Leider hat es keine Seitenumbrüche an den gewünschten Stellen erstellt.
Kann mir da jemand weiterhelfen?


Sub PDF_komplet_v4()
ActiveSheet.Unprotect
Range("H8").Select
ActiveCell.Value = ActiveCell.Value + 1
Sheets("Offer").Select
ActiveSheet.Unprotect
ActiveSheet.Range("$I$5:$J$612").AutoFilter Field:=1
ActiveSheet.Range("$I$5:$J$612").AutoFilter Field:=2
Rows("36:48").Select
Selection.Delete Shift:=xlUp
Sheets("Candidate").Select
Rows("71:83").Select
Selection.Copy
Sheets("Offer").Select
Rows("36:36").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveSheet.Range("$I$5:$J$612").AutoFilter Field:=1, Criteria1:=Array( _
"#WERT!", "x"), Operator:=xlFilterValues
ActiveSheet.Range("$I$5:$J$612").AutoFilter Field:=2, Criteria1:=Array( _
"#WERT!", "x"), Operator:=xlFilterValues
Sheets("Candidate").Select
Range("B7:C7").Select
Dim LastRow As Long
Dim Zelle As Range
LastRow = Cells(Rows.Count, 11).End(xlUp).Row
Application.ScreenUpdating = False
For Each Zelle In Range("K1:K" & LastRow).SpecialCells(xlVisible)
If Zelle.Value = "*****" Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Zelle
End If
Next
Application.ScreenUpdating = True
Sheets("Offer").Range("A1:H612").ExportAsFixedFormat xlTypePDF, _
Filename:="\\shdc\user$\jtsc\PData\Desktop\Offertentool\" & Sheets("Offer").Range("B8") & " ,V " & Sheets("Offer").Range("H8") & ".pdf", _
Openafterpublish:=True
Worksheets("Offer").ResetAllPageBreaks
Sheets("Offer").Protect
Sheets("Candidate").Protect
End Sub

>
P.S. Leider sind die Daten im Excel klassifiziert und ich kann nicht das ganze Dokument hochladen.

Dim LastRow As Long Dim Zelle As Range Application.ScreenUpdating = False With Worksheets("Offer") LastRow = .Cells(.Rows.Count, 11).End(xlUp).Row For Each Zelle In .Range("K1:K" & LastRow).SpecialCells(xlVisible) If Zelle.Value = "*****" Then .HPageBreaks.Add Before:=Zelle End If Next Application.ScreenUpdating = True

Sub Seitenumbruch() Dim L As Long Application.ScreenUpdating = False 'reset ActiveSheet.ResetAllPageBreaks For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(L, 11) = "*****" And Not Rows(L).Hidden Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(L, 11) End If Next Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread