Listenauswertung - Laufzeitfehler 1004:
27.03.2015 14:45:43
Paul
ich versuche aus einer Auflistung / einem Protokoll in dem Arbeitsaufträge aus verschiedenen Gremien aufgeführt sind, per Makro einen "Report" zu erstellen, der wiederum an unterschiedliche Empfängerkreise verschickt werden soll.
D.h. es wird zum einen nach dem Gremium und zum anderen nach "erledigt/nicht erledigt" gefiltert und soll dann im selben Format in eine neue Excel Datei kopiert werden.
Die Filterung, Markierung und das Erzeugen einer neuen Datei bekomme ich mit folgendem Code gut hin. Allerdings bekomme ich bei PasteSpecial immer einen Laufzeitfehler 1004 ("Die PasteSpecial-Methode des Range-Objektes konnte nicht ausgeführt werden"). Offenbar wir mir der Zwischenspeicher immer geleert.
Sub Auftraege_kopieren()
Application.ScreenUpdating = False
Dim Gremium As String
Gremium = InputBox("Bitte das auszuwertende Gremium eingeben:", "AutoFilter")
Selection.AutoFilter Field:=1, Criteria1:=Gremium, Operator:=xlFilterValues
Selection.AutoFilter Field:=9, Criteria1:=Array("0", "1"), Operator:=xlFilterValues
ActiveSheet.Range("A1:J" & ActiveSheet.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible) _
.Copy
Call Report_erstellen
MsgBox ("Der Bericht wurde erstellt")
Call Filter_aufheben
Application.ScreenUpdating = True
End Sub
Sub Report_erstellen()
Dim Report As Workbook
Set Report = Workbooks.Add
Application.SheetsInNewWorkbook = 1
Application.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
ActiveSheet.PageSetup.PrintArea = Range("A1:J" & ActiveSheet.UsedRange.Rows.Count).SpecialCells( _
xlCellTypeVisible).Address
Report.SaveAs Environ("Userprofile") & "\Desktop" & InputBox("Bitte den Namen des Reports _
eingeben:") & ".xlsx"
ActiveWindow.Close
End Sub
Sub Filter_aufheben()
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=9
End Sub
Viele Grüße
Paul
Anzeige