Sub Drucken()
Dim Zelle As Range, ws1 As Worksheet, wsReg As Worksheet, fehler%
On Error GoTo fehler
Set ws1 = Worksheets("Tabelle1")
For Each Zelle In ws1.Range("B6:B13,D6:D13,F6:F13")
If Zelle.Value > 0 Then
fehler = 1
Set wsReg = Worksheets(Zelle.Offset(0, 1).Value)
fehler = 0
wsReg.PrintOut Copies:=Zelle.Value
' wsReg.PrintPreview
End If
NextBlatt:
Next
GoTo ende
fehler:
Select Case fehler
Case 1
MsgBox "Der Name des Tabellenblatts in Tabelle 1: " & Zelle.Offset(0, 1) _
& vbLf & " existiert nicht!"
Resume NextBlatt
Case Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End Select
ende:
Set ws1 = Nothing: Set wsReg = Nothing: Set Zelle = Nothing
End Sub
Sub Drucken()
Dim Zelle As Range, ws1 As Worksheet, wsReg As Worksheet, fehler%
On Error GoTo fehler
Set ws1 = Worksheets("Tabelle1")
For Each Zelle In ws1.Range("B6:B13,D6:D13,F6:F13")
If Zelle.Value > 0 Then
fehler = 1
Set wsReg = Worksheets(Zelle.Offset(0, 1).Value)
fehler = 0
With wsReg
'Titelzeilen festlegen (werden auf jeder Seite wiederholt)
.PageSetup.PrintTitleRows = .Range(.Rows(5), .Rows(5)).Address
'Druckbereich festlegen
.PageSetup.PrintArea = .Range(.Cells(6, 2), _
.Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 5)).Address
.PageSetup.CenterHorizontally = True
End With
wsReg.PrintOut Copies:=Zelle.Value
' wsReg.PrintPreview
End If
NextBlatt:
Next
GoTo ende
fehler:
Select Case fehler
Case 1
MsgBox "Der Name des Tabellenblatts in Tabelle 1: " & Zelle.Offset(0, 1) _
& vbLf & " existiert nicht!"
Resume NextBlatt
Case Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End Select
ende:
Set ws1 = Nothing: Set wsReg = Nothing: Set Zelle = Nothing
End Sub