Erstmal nur um dem drohenden "Augenkrebs" vorzubeugen. Nur bezweifle ich, dass dir jemand so etwas ohne Vorlagedatei(en) nachbaut.

Ich arbeite momentan an einem Projekt und komme leider nicht weiter.
Ich muss aus einem Excel Dokument ein Diagramm kopieren und in eine PPT Vorlage einfügen(siehe erste schritte).
Das klappt auch hervorragend. Jetzt habe ich aber das Problem, dass es drei verschiedene Filter gibt.

Der erste ist die Flugroute, der zweite der Monat und die dritte welcher Carrier geflogen ist.

Auf seite drei der PPT kommt erstmal ganz links oben Monat 11 von beiden carriern einer strecke.
Dann zentral daneben der 12.Monat und ganz rechts der 1. Monat.
Am anfang sind auch beide carrier ausgewählt.  in der zweiten reihe kommt dann der elfte Monat wieder ganz link von der ausgewählten strecke, jedoch nur mit einem der carriern.
In der Mitte wieder die selbe strecke mit dem einen carrier aber der 12. Monat. Ganz rechts kommt dann Monat 1, slebe strecke und selber carrier.

Das muss für 5 Strecken gemacht werden mit jeweils 5 Monaten( 2. und 3. Monat kommen auf eine slide dahinter).
Ich habe es erst manuell versucht aber irgendwann war das makro zu lang und wollte nicht mehr.

Zum Verständnis habe ich meinen Code angefügt:

Sub test()
Dim PowerPointFile As PowerPoint.Presentation
Dim PPTPres As Object
Dim cht As Excel.ChartObject
Dim newPowerPoint As PowerPoint.Application
Dim Slides As PowerPoint.Slide
Dim activepresentation As PowerPoint.Presentation
Dim shapes As PowerPoint.Shape
Dim activeSlide As PowerPoint.Slide
Dim i As Integer
Dim height As Integer
Dim width As Integer
Dim xpos As Integer
Dim ypos As Integer

Grafik = ActiveWorkbook.Name

            
Set PPTPres = CreateObject("PowerPoint.application")


Set PowerPointFile = PPTPres.Presentations.Open("Pfad zu meiner Vorlage")
 
 
Set PPTPres = PPTPres.activepresentation
Set cht = ActiveSheet.ChartObjects("Diagramm 1")
 
   
         ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").ClearManualFilter
            With ActiveWorkbook.SlicerCaches("Datenschnitt_Mapping_Route")
        .SlicerItems("Ham-Bhg").Selected = False
        .SlicerItems("Tro-Ham").Selected = False
        .SlicerItems("Sqv-Ham").Selected = True
        .SlicerItems("(Leer)").Selected = False
    End With
                                   
                                        
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("VS").Selected = True
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("SK").Selected = True
                    
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("11").Selected = True
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("1").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("2").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("3").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("10").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("12").Selected = False

 
 Sheets("Pivot").ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy



Sheets("Pivot").ChartObjects("Diagramm 1").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
    .Top = 68
    .height = 5
    .width = 180
    .Left = 40
End With
                    
  SO WÜRDE DIE Fortsetzung AUSSEHEN FÜR JEDES EINZELNE:
        
         ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").ClearManualFilter
            With ActiveWorkbook.SlicerCaches("Datenschnitt_Mapping_Route")
        .SlicerItems("route").Selected = False
        .SlicerItems("Ham- Sto").Selected = False
        .SlicerItems("Ham-Svq").Selected = True
        .SlicerItems("(Leer)").Selected = False
    End With
    
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("SK").Selected = True
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("JK").Selected = True
                 
                   
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("11").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("1").Selected = True
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("2").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("3").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("10").Selected = False
                    ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("12").Selected = False

Sheets("Pivot").ChartObjects("Diagramm 1").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
    .Top = 68
    .height = 5
    .width = 180
    .Left = 475
    
    
    
End With

Das geht natürlich noch seeeeehr lange weiter :(

Würde mich über eine Rückmeldung freuen!!
LG NIklas