Bei folgendem Problem komme ich nicht weiter.
Ich kopiere mit untenstehendem Code eine gefilterte Ansicht über 12 Tabellenblätter auf ein Temporäres Tabellenblatt und Drucke dann diese "Zusammenfassung" aus.
Das ganze funktioniert auch alles einwandfrei.
Da aber die Anzahl der gefilterten Mitarbeiter unterschiedlich sein kann, möchte ich auf dem Temporären Tabellenblatt die "Aneinanderreihung" der einzelnen "Bilder" dynamisch halten. Das heisst bei zB. Paste Destination:=.Range("A22") möchte ich den Range nicht fix auf ("A22") setzen sondern dynamisch an das erste "Bild" anhängen.
Könnt ihr mir weiterhelfen?
Besten Dank
Gruss
Roland
Sub DruckenJahresuebersicht()
Dim Bereich As Range
Dim i As Integer
Set Bereich = Range("A1:BO" & Cells(Rows.Count, 3).End(xlUp).Row)
'Anzahl gefilterte Mitarbeiter zählen
ActiveSheet.Unprotect myPwd
i = Intersect(Bereich.SpecialCells(xlVisible), _
Bereich.Columns(1)).Count - 1
ActiveSheet.Protect myPwd
'Anzahl Mitarbeiter überprüfen
If i > 18 Then
MsgBox "Es sind zuviele Mitarbeiter Ausgewählt! Bitte Filter setzen!", vbInformation, " _
Druckmenü"
Exit Sub
End If
' Temporäres Tabellenblatt erstellen
Application.ScreenUpdating = False
Worksheets.Add Before:=Worksheets(1)
On Error Resume Next
With Worksheets(1)
'Januar Kopieren
Worksheets("Januar").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A1")
'Februar Kopieren
Worksheets("Februar").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A22")
'März Kopieren
Worksheets("März").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A43")
'April Kopieren
Worksheets("April").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A64")
'Mai Kopieren
Worksheets("Mai").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A85")
'Juni Kopieren
Worksheets("Juni").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A106")
'Juli Kopieren
Worksheets("Juli").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A127")
'August Kopieren
Worksheets("August").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A148")
'September Kopieren
Worksheets("September").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A169")
'Oktober Kopieren
Worksheets("Oktober").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A190")
'November Kopieren
Worksheets("November").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A211")
'Dezember Kopieren
Worksheets("Dezember").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A232")
On Error GoTo 0
'Ausdrucken
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.Orientation = xlPortrait
.Zoom = 70
End With
'.PrintOut
Application.Dialogs(xlDialogPrint).Show
'Temporäres Tabellenblatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Menüleiste.AktuellerMonat
Application.ScreenUpdating = True
End Sub