Grüß dich,

das mit dem zweiten Kriterium klappt jetzt super. Nur leider klappt der Autofilter dabei nicht. Er nimmt zwar die Kriterien auf aber filtert die Daten dann nicht... Es werden dann in der Tabelle keine Daten angezeigt. Wenn ich dann in die Filteroptionen reinschaue (die Schleife einmal mit F8 durchgetestet) steht hier dann auch richtig Soll größer als -10,5 sein und kleiner gleich -5. Wenn ich dann "ok" drücke werden die Daten komischerweise in der Tabelle richtig angezeigt.

Ich glaube es liegt an der Variablendeklaration von Elast und Elast2...

Wenn ich Elast als Integer deklariere dann nimmt er nur -10 anstatt -10,5 auf.

Wenn ich Elast als Double deklariere nimmt er richtigerweise -10,5 an aber kann das dann nicht mehr auf den Autofilter anwenden.

Eine Idee? mit Long nimmt er nur -10 auf und mit Variant kann er den filter wieder nicht anwenden...

Vielen Dank!

Beste Grüße

Max

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:=">" & Elast & "", Operator:=xlAnd, Criteria2:="<=" & 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
            End If
           
        
        Next x
        
        Next i
        
  
End Sub