Hallo! ALso hab mir den Code mal angeschaut. Frage 1. Du hast 11 Kriterien (A bis K), willst aber nur 10 auswerten? Ansonsten tritt bei dir oben der Fehler auf, weil du bei next i noch in der Schleife von x bist. Da hast du i und x verwechselt. Bei mir traten dann aber noch mehr Fehler auf. (xldown +1). ZUdem solltest du noch einbauen, ob der FIlter auch was findet. Und die Schleife von Exposnum ist mE falsch. Du gehst damit durch alle Eintragungen für alle Kriterien. DA du aber zudiesem Zeitpunkt noch bei x 1 bist, trägt er auch bei Kriterium 2 etc. die Auswertung vom Kriterium 1 ein. Das muss also raus und in Abhängigkeit von i exposnum erhöht werden.

Habe unten mal ein Beispiel. Haben deinen Code angepasst. DAbei wird aber noch ein Name (das Datum wie beschrieben ) eingefügt und dann erst der Name und dann die Werte. Das oben geschrieben ist mit behoben. Zumindest in meiner gebastelten Umgebung hat es geklappt. Schau mal ob as so passt. VG

Public DataReturn, DataExposure, PFExposure As Worksheet


Sub SortExposure()

Set DataReturn = Worksheets("Monatl. Aktienrenditen(1)")
Set DataExposure = Worksheets("monatl. Ölexposure")
Set PFExposure = Worksheets("<- Öl Portfolio")

Dim letzte As Long  'nimmt die letzte Zeile zum eintragen auf

Dim x As Integer

Dim Elast As Integer 'Kriterium
Dim i As Integer

Dim Exposnum As Integer

For i = 1 To 11  ' Schleife für das Kriterium

    Elast = PFExposure.Cells(3, i).Value ' Nehme den Wert für das Kriterium auf
    ' erhöht um 3 bei jedem x dadurch ist die Schrittweite 3 gewahrt
    Exposnum = 3 * i - 2 'ist immer die Zeile zum Einfügen,keine Schleife, sonst wird dein Kriterum 1 auch bei Kriterum 2 eingetragen
        
         For x = 2 To 180 Step 1 ' Schleife für die einzelnen Monate

            DataExposure.Range("A:FY").AutoFilter Field:=x, Criteria1:=">" & Elast & "", Operator:=xlAnd, Criteria2:="<=" & Elast + 1 & ""
            
            'prüfen, ob Auotfiler was ergibt
            If DataExposure.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                 'letzten Eintrag suchen, in erste Spalte des 3er Packs, da dort das Datum drüber steht
                 letzte = PFExposure.Cells(Rows.Count, Exposnum).End(xlUp).Row  'ich habe mal in Spalte 1 gesucht, wegen der Überschrift des Monates
                'Datum einfügen
                PFExposure.Cells(letzte + 1, Exposnum) = DataExposure.Cells(1, x)
            
                'Namen kopieren
                DataExposure.Range("A2:A" & ActiveSheet.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Copy
            
                PFExposure.Cells(letzte + 2, Exposnum).PasteSpecial
            
                'Daten kopieren
                DataExposure.Range(Cells(2, x), Cells(ActiveSheet.UsedRange.Rows.Count, x)).SpecialCells(xlCellTypeVisible).Copy
            
                PFExposure.Cells(letzte + 2, Exposnum + 2).PasteSpecial

                DataExposure.ShowAllData
            End If
        Next x ' Hier erscheint der Fehler
  
Next i

End Sub