Nochmal ungetestet. Den Filter anstelle von ShowAllData nochmal aufrufen dann ist er wieder weg. Habe das mal so mit reimgemacht. Ggf nochan die St() und Double Änderunge anpassen

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 Variant 'Kriterium
Dim Elast2 As Variant
   
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 von auf
    Elast2 = PFExposure.Cells(3, i + 1).Value ' Nehme den Wert für das Kriterium bis 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:=">" & Str(Elast) & "", Operator:=xlAnd, Criteria2:="<=" & Str(Elast2) & ""
                
            '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
                'filter nochmal aufrufen löscht ihn wieder
                DataExposure.Range("A:FY").AutoFilter
            End If
             
          
        Next x
          
        Next i
          
    
End Sub