Hallo zusammen
,
ich hätte da schon ein Thema: ich ziehe eine Liste aus dem SAP zu diversen Kostenstellen. Diese Daten kommen in eine Übersichtsdatei für mich, damit ich alle Kostenstellen im Blick habe. An die Bereiche soll aber nur jeweils ihre Kostenstelle geschickt werden. Um aus der Übersichtsdatei ("773090,773095_Plan-Ist 2015.xlsm") die Daten in Einzelberichte (z.B. "250001_Quartalsbericht KT200090.xlsx") zu bekommen habe ich das unten stehenden Makro aufgezeichnet.
Dabei wiederholt sich die Programmierung natürlich pro Kostenstelle (in einigen Berichten werden auch mehrere Kostenstellen dargestellt) und je Quartal, da es pro Quartal eine Auswertung geben soll. Leider bricht das Programm nach ein paar Kostenstellen ab und ist bis dahin auch ziemlich langsam. Kann mir da jemand helfen?
Danke schon mal im voraus
Viele Grüße
Lydia
Sub Einzel()
'
' in Übersichtsdatei Q1-Daten auf 250001 filtern und dann in Einzelbericht 250001 in Details Q1 kopieren
'
'
Windows("773090,773095_Plan-Ist 2015.xlsm").Activate
Sheets("Q1").Select
ActiveSheet.Range("$A$1:$S$99999").AutoFilter Field:=1, Criteria1:="250001"
Columns("A:S").Select
Selection.Copy
Windows("250001_Quartalsbericht KT200090.xlsx").Activate
Sheets("Details Q1").Select
Columns("A:A").Select
ActiveSheet.Paste
Windows("773090,773095_Plan-Ist 2015.xlsm").Activate
Sheets("Q2").Select
ActiveSheet.Range("$A$1:$S$99999").AutoFilter Field:=1, Criteria1:="250001"
Columns("A:S").Select
Selection.Copy
Windows("250001_Quartalsbericht KT200090.xlsx").Activate
Sheets("Details Q2").Select
Columns("A:A").Select
ActiveSheet.Paste[/color][/color]
' in Übersichtsdatei Q1-Daten auf 453010 und 454010 filtern und dann in Einzelbericht in Details Q1 kopieren
Windows("773090,773095_Plan-Ist 2015.xlsm").Activate
ActiveSheet.Range("$A$1:$S$99999").AutoFilter Field:=1, Criteria1:="=453010", _
Operator:=xlOr, Criteria2:="=454010"
Columns("A:S").Select
Selection.Copy
Windows("453010+454010_Quartalsbericht KT200090.xlsx").Activate
Sheets("Details Q1").Select
Columns("A:A").Select
ActiveSheet.Paste
' in Übersichtsdatei Q1-Daten auf 401000 filtern und dann in Einzelbericht 401000 in Details Q1 kopieren
Windows("773090,773095_Plan-Ist 2015.xlsm").Activate
ActiveSheet.Range("$A$1:$S$99999").AutoFilter Field:=1, Criteria1:="401000"
Columns("A:S").Select
Selection.Copy
Windows("401000_Quartalsbericht KT200090.xlsx").Activate
Sheets("Details Q1").Select
Columns("A:A").Select
ActiveSheet.Paste
...
End Sub