CSV Dateien zusammen führen und neu abspeichern

Sub zusammenfuegen()
    Dim strDateiname As String
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim inLetzte As Integer
    Dim x As Integer
    Dim StartPaste As Integer
    StartPaste = 0
    x = 1
    
    With Application.FileDialog(msoFileDialogFolderPicker)
     
        .AllowMultiSelect = False
        .Title = "Bitte Ordner wählen"  
        .InitialFileName = ""  
        .InitialView = msoFileDialogViewThumbnail
        .ButtonName = "OK"  
     
        If .Show = -1 Then
            GetExcelFolder = .SelectedItems(1)
            'MsgBox GetExcelfolder  
        End If
    
    End With
    
    Application.ScreenUpdating = False
    'strDateiname = Dir(ThisWorkbook.Path & "\*.csv")  
    strPath = Dir(GetExcelFolder)
    strDateiname = Dir(GetExcelFolder & "\*.csv")  
    With ThisWorkbook.Worksheets("Tabelle1")  
        Do While strDateiname <> ""  
            If strDateiname <> ThisWorkbook.Name Then
                'Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname  
                Workbooks.Open Filename:=GetExcelFolder & "\" & strDateiname  
                loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
                    If x = 1 Then
                    StartCell = 1
                    StartPaste = 0
                    Else
                    StartCell = 3
                    StartPaste = 1
                    End If
                x = x + 1
                ActiveWorkbook.ActiveSheet.Range(Cells(StartCell, 1), Cells(loLetzte2, inLetzte)).Copy Destination:=.Cells(loLetzte1 + StartPaste, 1)
                ActiveWorkbook.Close True
            End If
            strDateiname = Dir
        Loop
    End With
        
    Application.ScreenUpdating = True
End Sub