Druckbereich

[Max11]

Hier der folgende Code.
Vielleicht kann man das ja so ändern das nicht Standard wert 46 ist pro Tour sondern beliebig die Toren festlegt.
lg





Dim Menge
Dim LfdMin
Dim LfdMax
Dim Tour
Dim TourI
Dim KLT

Sheets("LSA").Select

' setzt Filter um ihn nachher löschen zu können
ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000
' Löscht Filter
ActiveSheet.ShowAllData

' Ermittlung der letzten Zeile
Dim Ende As Long

With ActiveSheet
Ende = .Cells(.Rows.Count, 2).End(xlUp).Row
End With

' Löscht bedingte Formatierung in Spalte A

Range("A3:C" & Ende).Select
Selection.FormatConditions.Delete

' Ermittelt Anzahl der KLTs (Wert in letzter Zeile Lfd-Nr)
KLT = Range("A" & Ende).Value

' Summe der KLTs pro Tour
Range("H1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[9999]C)"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With


Menge = InputBox("Bitte Anzahl KLT pro Tour eingeben" & vbCrLf & "Zum Drucken OK wählen", "Drucken", 46)

If Menge = "" Then
GoTo EndPrint
Else
' WA 1.2 Calculate number of tours with 5 more than total add hard exit of tour loop.
' Because it might be wrong, if each of the first tours have less than defined KLTs

Tour = Application.RoundUp((KLT + 10) / Menge, 0)
'Tour = 100

LfdMin = 0
For TourI = 1 To Tour

Sheets("LSA").Select

LfdMax = Menge + LfdMin
ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & LfdMax, _
Operator:=xlAnd, Criteria2:=">" & LfdMin

' maximal 46 KLTs
ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=3, Criteria1:="<=" & LfdMax, _
Operator:=xlOr, Criteria2:="="

LfdMax = Cells(1, 8) + LfdMin


' Hilfsspalte für Schattierung der ersten Spalte je Tour
Columns("Q:Q").Select
Selection.EntireColumn.Hidden = False

Range("Q3:Q" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells(1).Select

Range("Q3:Q" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Select

ActiveCell.FormulaR1C1 = TourI
If LfdMax - LfdMin <> 1 Then
Selection.FillDown
End If

Columns("Q:Q").Select
Selection.EntireColumn.Hidden = True

' ----------------------

Range("F1").Select
ActiveCell.FormulaR1C1 = "Delivery-List - Tour " & TourI
Selection.Font.Bold = True

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'LfdMin = LfdMin + Menge


Sheets("MA").Select
ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & LfdMax, _
Operator:=xlAnd, Criteria2:=">" & LfdMin

Range("F1").Select
ActiveCell.FormulaR1C1 = "Pick-List - Tour " & TourI
Selection.Font.Bold = True

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

' WA 1.2 Exit of loon, if number of tours has been calculated to high
If LfdMax = KLT Then
GoTo EndPrint
End If

LfdMin = LfdMax

Next TourI

End If

EndPrint:

Sheets("MA").Select
' setzt Filter um ihne nachher löschen zu können
ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000
' Löscht Filter
ActiveSheet.ShowAllData

Sheets("LSA").Select
' setzt Filter um ihne nachher löschen zu können
ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000
' Löscht Filter
ActiveSheet.ShowAllData


' Cond. formatting to show selected routes in total pick-list

If Menge = "" Then
GoTo EndSub
Else
Range("A3:A" & Ende).Select
Range("A3").Activate
'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISTGERADE(AUFRUNDEN(A3 /" & Menge & "; 0))"
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISTGERADE(Q3)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
End If

EndSub:

End Sub