Regrouper pls classeurs en un seul

Sub Import_CSV()
    'disque
    ChDrive "D"
    'repertoire fonction du mois
    'pourrait etre une inputbox si besoin de choisir le mois
    ChDir "D:\_ACSV\" & Format(Date, "mmmm") & "\"
    'fichier existe
    Nom_Fichier = Dir("*.CSV")
    If Nom_Fichier <> "" Then   'fichier ok
        'nouveau classeur
        Workbooks.Add
        Do While Nom_Fichier <> ""
            'nouvel onglet
            ActiveWorkbook.Worksheets.Add
            'import fichier cvs
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Nom_Fichier, Destination:=Range("$A$1"))
                '.CommandType = 0
                '.Name = Nom_Fichier     ' voir pour le nom de l'onglet
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 1252
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = True
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
            'renomme l'onglet
            ActiveSheet.Name = Nom_Fichier     ' voir pour le nom de l'onglet
            Nom_Fichier = Dir
        Loop
        'voir pour le repertoire de sauvegarde
        ActiveWorkbook.SaveAs Filename:="Synthese_" & Format(Date, "mmmm") & ".xlsx"
        ActiveWorkbook.Close False
    Else
        MsgBox "Attention, pas de fichier ou repertoire !!!!!!"
    End If
End Sub