Packzettel drucken VBA

Sub Makro3a() Dim Blatt As Object On Error Resume Next ' Bei Fehler wird die nächste Zeile ausgeführt 'es gibt auch Druckaufträge mit null Sheets("Zettel").Select Range("B27").Select ActiveCell.FormulaR1C1 = "=+Tabelle1!R3C4" ' Kunde nach jedem Zyklus eine Zelle _ nach rechts ' bis leere zelle Range("D27").Select ActiveCell.FormulaR1C1 = "=+Tabelle1!R4C4" ' Farbe nach jedem Zyklus eine Zelle _ _ nach rechts Range("C29").Select ActiveCell.FormulaR1C1 = "=+Tabelle1!R7C1" ' Produkt jede Runde eine Zelle nach unten _ _ von 'a7 bis a37 _ _ ' bis leere zelle Calculate For Each Blatt In Worksheets With Blatt .PrintOut From:=1, To:=1, Copies:=.Range("a1") .PrintOut From:=2, To:=2, Copies:=.Range("b1") End With Next Blatt End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub drucken() ' Makro1 Makro Sheets(1).Select For Each rw In Range("A4:A999").SpecialCells(xlCellTypeConstants, xlNumbers) For Each cl In Range(Cells(rw.Row, "D"), Cells(rw.Row, "M")) If cl > 0 Then With Sheets("Zettel") .Range("B27") = Cells(3, cl.Column) 'Kunde .Range("D27") = Cells(4, cl.Column) 'Farbe .Range("C29") = Cells(rw.Row, "A") 'Artikelnummer .Range("D29") = Cells(rw.Row, "B") 'Artikelbez. If .Range("a1") > 0 Then .PrintOut From:=1, To:=1, Copies:=.Range("a1") If .Range("b1") > 0 Then .PrintOut From:=2, To:=2, Copies:=.Range("b1") End With End If Next cl Next rw End Sub

Hallo
kann man sicher auch so aufbauen, dass anstelle der Werte direkt die Werte eingetragen werden...
hier mal unter beibehaltung deiner Formeln


Sub Makro3a()
Dim Anz1 As Integer, Anz2 As Integer
Dim LR As Long, LC As Integer
Dim ZE As Integer, SP As Integer, L1 As Integer, S1 As Integer
Dim Z As Integer, S As Integer
On Error Resume Next    ' Bei Fehler wird die nächste Zeile ausgeführt
'Fehler wird nicht angezeigt
L1 = 7: ZE = 3: SP = 1: S1 = 4
With Sheets("Zettel")
LR = Sheets("Tabelle1").Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
LC = Sheets("Tabelle1").Cells(ZE, Columns.Count).End(xlToLeft).Column 'letzte Spalte  _
einer Zeile
For Z = L1 To LR
.Range("C29").Formula = "=Tabelle1!A" & Z ' Produkt jede Runde eine Zelle nach  _
unten von
If .Range("D29")  "0" Then 'keine leeren Zeilen verarbeiten
For S = S1 To LC
.Range("B27").FormulaR1C1 = "=Tabelle1!R3C" & S ' Kunde nach jedem Zyklus  _
eine Zelle nach rechts
.Range("D27").FormulaR1C1 = "=Tabelle1!R4C" & S ' Farbe nach jedem Zyklus  _
eine Zelle nach rechts
.Range("E5").FormulaR1C1 = _
"=FLOOR(SUMIF(Tabelle1!C1,R[24]C[-2],Tabelle1!C" & S & ")/40,1)"
.Range("E6").FormulaR1C1 = _
"=MOD(SUMIF(Tabelle1!C1,R[23]C[-2],Tabelle1!C" & S & "),40)"
Calculate
Anz1 = .Range("A1")
Anz2 = .Range("B1")
If Anz1 > 0 Then .PrintOut From:=1, to:=1, Copies:=Anz1
If Anz2 > 0 Then .PrintOut From:=2, to:=2, Copies:=Anz2
Next S
End If
Next Z
End With
End Sub

Gruß UweD

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread