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
Hola,
Zitat: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
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
In welche Forum soll ich den Beitrag verlinken ?
Hab es leider nicht verstanden, tut mir leid
LG
In jedem Forum wo die Frage steht kommt ein Link zum dem/den anderen Forum/Foren.
In den Forum wo ich gefragt habe konnte mir leider keiner helfen ..
Aber danke für den Hinweis
LG
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