Hallo zusammen,

folgende Ausgangssituation:

Das Makro (hier noch unvollständig) soll alle Arbeitsmappen bzw. die darin befindlichen und in Anzahl und Bezeichnung variablen Reiter durcharbeiten, sofern in dem jeweiligen Reiter in Zelle M173 ein Wert ungleich 0 steht. Sofern 0 drinsteht, soll das Makro nicht abbrechen, sondern den Reiter überspringen und mit dem nächsten Reiter weitermachen.

Mein Problem: Zwar öffnet das Makro die erste Arbeitsmappe und nimmt eine entsprechende Formatierung vor, jedoch geht es anschließend nicht weiter, d.h. die dahinter liegenden Reiter werden nicht angesprochen…. Hat jemand einen Tipp für mich?

Sub Aufbereitung()

    Dim cDir As String
    Dim sPath As String
    Dim i As Integer

 
    Excel.Application.EnableEvents = False
    Application.DisplayAlerts = False
        
    sPath = ThisWorkbook.Path & "\verarbeiten\"
    cDir = Dir(sPath & "*.xlsm")


   
    Do While cDir <> ""
        Workbooks.Open (sPath & cDir)
        
        Sheets("Übersicht").Delete
        Sheets("BEZ").Delete
        Sheets(1).Select

    For i = 1 To Sheets.Count
    With Sheets(i)
        
         ActiveSheet.Unprotect "controlling2020"
         
         
         Cells.Select
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
            Application.CutCopyMode = False
       
         If ActiveSheet.Range("M173").Value <> "0" Then
                 
         
         ActiveSheet.Outline.ShowLevels RowLevels:=2
            Cells.Select
            Selection.Rows.Ungroup
    
            
                Range("B1").Select
                       
                Range("B8").Select
                ActiveCell.FormulaR1C1 = "Spalte B"
                Range("C8").Select
                ActiveCell.FormulaR1C1 = "Spalte C"
                Range("D8").Select
                ActiveCell.FormulaR1C1 = "Spalte D"
                Range("E8").Select
                ActiveCell.FormulaR1C1 = "Spalte E"
                Range("F8").Select
                ActiveCell.FormulaR1C1 = "Spalte F"
                Range("G8").Select
                ActiveCell.FormulaR1C1 = "Spalte G"
                Range("H8").Select
                ActiveCell.FormulaR1C1 = "Spalte H"
                Range("I8").Select
                ActiveCell.FormulaR1C1 = "Spalte I"
                Range("J8").Select
                ActiveCell.FormulaR1C1 = "Spalte J"
                Range("K8").Select
                ActiveCell.FormulaR1C1 = "Spalte K"
                Range("L8").Select
                ActiveCell.FormulaR1C1 = "Spalte L"
                Range("M8").Select
                ActiveCell.FormulaR1C1 = "Spalte M"
                Range("B8").Select
                Selection.AutoFilter
                ActiveSheet.Range("$A:$M").AutoFilter Field:=13, Criteria1:="<>0", Operator:=xlFilterValues
                ActiveSheet.Range("$A:$M").AutoFilter Field:=2, Criteria1:="<>"
                         
        
                Columns("D:L").Select
                Selection.Delete Shift:=xlToLeft
                Columns("B:B").Select
                Selection.Insert Shift:=xlToRight
                Range("B10") = Range("D3")
            
        
                Range("B10").Select
                Selection.Copy
                ActiveCell.Offset(0, 1).Select
                Selection.End(xlDown).Select
                ActiveCell.Offset(0, -1).Select
                Range(Selection, Selection.End(xlUp)).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                Range("B1").Select

                  
         End If
         End With
        Next
 
      
 
        cDir = Dir
        
        Excel.Application.EnableEvents = True
        Application.DisplayAlerts = True
        
    Loop
End Sub