Guten Morgen liebe Excelgemeinde,

das Thema findet man bei Google schon aber ich bekomm es trozdem nich hin :X Könntet Ihr mir vielleicht weiterhelfen?

Ausgangssituation: ich habe ein Makro geschrieben (zusammenkopiert trifft es eher), das in einem bestimmten Ordner eine .csv öffnet, formatiert und auf dem Desktop als xlsx speichert. Danach wird die ursprüngliche csv Datei in den Ordner "Importiert" verschoben. Klappt sogar alles.

Jetzt habe ich aber mehrere .csv Dateien im Ordner und das Makro verarbeitet nur die erste csv, speichert diese auf den Desktop und verschiebt dann alle csv Dateien in den Ordner "Importiert".

Soll: meine xlsm starten -> erste csv formatieren -> auf desktop speichern -> ursprüngliche Datei in den Ordner "Importiert verschieben

                                            zweite csv formatieren -> auf desktop speichern -> ursprüngliche Datei in den Ordner "Importiert verschieben

                                            .....alle bis keine mehr im Ordner ist...

                                            msgbox "alle Csv. Dateien wurden verarbeitet"

Das hier ist mein Code bisher:

Option Explicit

Private Sub Workbook_Open()

Call Bedarfsverursacher_ermitteln
Call Dateien_verschieben

End Sub

----------------Modul1------------------------------------------------------------

Sub Bedarfsverursacher_ermitteln()

Dim Zielarbeitsmappe As Object
Dim Quellenarbeitsmappe As Object
Dim Sheet As Worksheet
Dim Pfad As String
Dim Datei As String
Dim SaveName As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set Zielarbeitsmappe = ActiveWorkbook

'Eingabebox öffnen
Pfad = Environ("Userprofile") & "\Desktop\Makro\Sven\"
'Pfad = InputBox("Pfad eingeben", "Pfad")
Datei = Dir(CStr(Pfad & "*.csv"))
If Dir(Pfad & Datei) = "" Then
MsgBox "Hey Sven, leider habe ich keine Datei in dem Ordner gefunden"
Exit Sub
End If

Do While Datei <> ""

Set Quellenarbeitsmappe = Workbooks.Open(Pfad & Datei, False, True)
Quellenarbeitsmappe.Sheets().Copy After:=Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count)

Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count).Name = Datei

Quellenarbeitsmappe.Close
Datei = Dir()
Loop

'Tabelle-1 löschen

For Each Sheet In ActiveWorkbook.Worksheets

If Sheet.Name = "Tabelle1" Then
    Application.DisplayAlerts = False
    Sheet.Delete
    Application.DisplayAlerts = True
End If
Next Sheet

'Eingelesene Tabelle neu formatieren

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Columns("D:D").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
        OtherChar:="|", FieldInfo:=Array(Array(0, 1), Array(21, 1), Array(48, 1)), _
        TrailingMinusNumbers:=True
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Range("N2").Select
    Selection.FormulaArray = _
        "=IF(ROW()=1,""0"",(IF(R[-1]C=""Achtung"",""Achtung"",(IF(AND(RC[-13]=1),""Achtung"",(IF(OR(LEFT(RC[-13],8)=""Plancode"",LEFT(RC[-13],5)=""Ebene"",LEFT(RC[-12],2)="" +""),ROW(),""0"")))))))"
    Selection.AutoFill Destination:=Range("N2:N771"), Type:=xlFillDefault
    Range("N2:N771").Select
    Columns("A:N").Select
    ActiveSheet.Range("$A$1:$N$771").RemoveDuplicates Columns:=14, Header:=xlNo
    Rows("1:2").Select
    Selection.ClearContents
    Selection.Delete Shift:=xlUp
    Columns("D:D").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=WENN(LINKS(D1|15)=""EINSCHUBEINHEIT""|WAHR|FALSCH)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.14996795556505
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Columns("E:E").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=WENN(LINKS(E1|10)=""Bestellung""|WAHR|FALSCH)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5263615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Columns("G:G").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=WENN(ODER(TEIL(G1|4|1)=""S""|(TEIL(G1|4|1)=""A""))|WAHR|FALSCH)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A2:M2").Select
    Selection.AutoFilter
    Columns("N:N").Select
    Selection.ClearContents
    Range("P11").Select
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(RC[-12],9)"
    Range("M2").Select

'Datei auf Desktop speichern
     
       SaveName = ActiveSheet.Range("M1").Text
      
       'Datei ohne Makros (als XLSX-Datei) speichern
        Application.DisplayAlerts = False 'Fehlermeldungen aus
       'hier mit direkter Pfadangabe
        ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\Bedarfsverursacher" & SaveName & ".xlsx", _
                      FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True ' Fehlermeldungen an
      
  
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "Die CSV-Datei der Bedarfsverursacher wurde erfolgreich in eine .xlsx umgewandelt und vorgefiltert!"

Set Zielarbeitsmappe = Nothing
Set Quellenarbeitsmappe = Nothing

End Sub

-----------------------------Modul2---Csv Datei in Ordner "importiert" verschieben---------------------------------------

Public Sub Dateien_verschieben()
    Dim strQuelle As String
    Dim strZiel As String
    Dim objFSO As Object
   
    strQuelle = Environ("Userprofile") & "\Desktop\Makro\Sven\*.csv"
    If Dir(strQuelle) = "" Then
    Exit Sub
    End If
    strZiel = Environ("Userprofile") & "\Desktop\Makro\Sven\Importiert"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.MoveFile strQuelle, strZiel
    Set objFSO = Nothing
    MsgBox "Die Ausgangsdatei wurde in den Ordner 'Importiert' verschoben"
    
End Sub

Vielen Dank schonmal für eure Hilfe!!!