Druckbereich

[Max11]

Morgen Zusammen,

Ich habe eine Excel Datei mit 2 Tabellen, die sich des Öfteren mit neuen Inhalten ausgefüllt werden.
Aktuelle Läuft Folgende Makro :
Es kommt ein msgbox wo du den Standardwert "10" eingibst.
Daraufhin werden die Inhalte der Tabelle in 10er Schritten pro Blatt ausgedruckt.
Beispiel: Es gibt 35 Zeilen in der Tabelle
1-10 Zeile = 1 Blatt
11-21 Zeile = 2 Blatt
22-32 Zeile = 3 Blatt
33-35 Zeile = 4 Blatt

Gibt es die Möglichkeit das man beim msgbox selber individuell bestimmen kann wie viel Inhalte ein Blatt haben soll, Zum Beispiel das 1. Blatt bis 13 Zeilen ausgedruckt werden soll. Blatt 2 bis 20 Zeilen

ich hoffe das man mein Wunsch verstanden hat.
Wenn ist hilfreich ist, könnte ich auch das Makro bzw. den Code für den Jeweiligen zu schicken 
Würde mich für jede Hilfe freuen 
LG

[steve1da]

Hola,

Wenn ist hilfreich ist, könnte ich auch das Makro bzw. den Code für den Jeweiligen zu schicken

du kannst es auch einfach hier hin schreiben.
Gruß,
steve1da

[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

[steve1da]

https://office-fragen.de/thread-13.html
Bitte nachholen.

[Max11]

In welche Forum soll ich den Beitrag verlinken ?
Hab es leider nicht verstanden, tut mir leid

LG

[steve1da]

In jedem Forum wo die Frage steht kommt ein Link zum dem/den anderen Forum/Foren.

[Max11]

In den Forum wo ich gefragt habe konnte mir leider keiner helfen ..
Aber danke für den Hinweis 
LG

[steve1da]

Darum geht es nicht. Google nach Crossposting, vielleicht wird es dann klarer.
Edit: ok, scheinbar nicht....
https://www.herber.de/forum/archiv/1876t...ieren.html

[Max11]

danke für die Mühe Steve.

Könntest du mir vielleicht bei meinem anliegen weiter helfen ?

tut mir leid, aber ich bin echt verzweifelt ...

LG