AW: eine Vorlage mehrmals einfügen
11.09.2018 09:20:15
Gerd
Moin Andre
Sub teste()
Dim Seite As Integer, Gesamt As Integer
Dim NummerEins As Integer, Nummer As Integer, Etikett As Integer
Dim sh As Integer
Gesamt = Range("B3").Value
NummerEins = Range("B7").Value
Nummer = NummerEins - 1
For Seite = 1 To WorksheetFunction.RoundUp((Gesamt / 4), 0)
For Etikett = 1 To 4
Nummer = Nummer + 1
Select Case Etikett
Case 1: Range("B7").Value = Nummer
Case 2:
Range("B3:D20").Copy Destination:=Range("G3")
Range("G7").Value = Nummer
Case 3:
Range("B3:D20").Copy Destination:=Range("B23")
Range("B27").Value = Nummer
Case 4:
Range("B3:D20").Copy Destination:=Range("G23")
Range("G27").Value = Nummer
End Select
If Nummer = Gesamt Then Exit For
Next
MsgBox "Print" & Seite
ActiveSheet.PrintOut copies:=1
If Etikett > 1 Then
Range("G3:I20,B23:D40,G23:I40").Clear
For sh = Etikett To 2 Step -1
Shapes(sh).Delete
Next
End If
Next
Range("B7").Value = NummerEins
End Sub
Gruß Gerd