Hallo Leute,

bin ganz neu hier im Forum und kenne mich auch noch nicht besonders gut mit Excel bzw Vba aus.
Mein Problem ist, dass ich aus einer Excel-Tabelle Daten filtere, die ich dann per VBA in eine Power-Point Folie überspiele. Allerdings muss bei der Übertragung jede Zeile einzeln 'hart' eingegeben werden. Gibt es da eine Möglichkeit iwie nur z.B die ersten 8 Zeilen zu übertragen und nicht jedes mal einzugegebn um welche Zeile es sich konkret nach der Filterung handelt.

Hier mal als Bsp.:
1.Der Filter

Sub Makro3()

    ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=2, Criteria1:=Array("1A" _
        , "1B", "1C", "1D", "1F", "2A", "2B", "2C", "2D", "2E", "2F", "3", "4"), Operator:= _
        xlFilterValues
    ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=6, Criteria1:=Array( _
        "Active", "Proposed", "Resolved"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=2, Criteria1:=Array("1A" _
        , "2A", "2B", "2C", "2D", "2E", "2F", "3"), Operator:=xlFilterValues
    ActiveWindow.SmallScroll Down:=-108
End Sub

2.Die Übertragung in PPT

Sub PPTausExcelBefuellen()
Dim powerpoint_datei As Object
Dim ppt_slides As Variant

Set powerpoint_datei = _
CreateObject(class:="Powerpoint.Application")
powerpoint_datei.presentations.Open Filename:="Interim Status Template bearbeitet.pptx"
ppt_slides = 1


        Dim TextTFS1 As String
        Dim TextTFS2 As String
        Dim TextTFS3 As String
        Dim TextTFS4 As String
      
        TextTFS1 = Replace(Cells(318, 1).Text, Chr(10), Chr(13))
        TextTFS2 = Replace(Cells(324, 1).Text, Chr(10), Chr(13))
        TextTFS3 = Replace(Cells(479, 1).Text, Chr(10), Chr(13))
        TextTFS4 = Replace(Cells(491, 1).Text, Chr(10), Chr(13))
With powerpoint_datei.ActivePresentation.Slides(ppt_slides)
            .Shapes("TFS1").TextFrame.TextRange.Text = TextTFS1
            .Shapes("TFS2").TextFrame.TextRange.Text = TextTFS2
            .Shapes("TFS3").TextFrame.TextRange.Text = TextTFS3
            .Shapes("TFS4").TextFrame.TextRange.Text = TextTFS4
End With


End Sub

Vielen Dank für eure Hilfe!