XL pour MAC XL pour MAC Assembler plusieurs fichiers CSV dans un fichier / seul classeur

jnce84

XLDnaute Nouveau
Bonjour,

Je me permets de solliciter votre aide car je travaille sur des exportations de DATA via un site internet et pour chaque étude, j'extrais un fichier CSV. A la fin de mon étude, je me retrouve avec une vingtaine de fichiers que je dois ouvrir un par un pour pouvoir en constituer qu'un seul pour traiter ensuite mes DATA. Je perds un temps fou à ouvrir chaque fichier pour voir coller les datas dans un seul fichier / un seul classeur. Idéalement j'aimerai supprimer les doublons en même temps :)

Voici un exemple de 3 fichiers que je voudrais assembler en un seul (Fichier Assemblage)

Merci pour votre aide, ça me ferait gagner un temps fou pour chaque export.
 

Pièces jointes

  • Archive.zip
    54.5 KB · Affichages: 12

ChTi160

XLDnaute Barbatruc
Bonjour
une première approche pour lister les Fichiers présents dans le Dossier des Archives
Code:
Public Sub FileSearch()
    Dim StrFolder As String
    Dim objFolder
    Dim FileCsv
    Dim fFile As Integer
    Dim StrPath As String
    Dim f As File
    Dim objFile As File
           StrFolder = ThisWorkbook.path & "\__MACOSX\" 'chemin du Fichier Archive
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(StrFolder)
        Set colFiles = objFolder.Files
          LigneCible = 0
With Worksheets("Feuil3")
    For Each f In colFiles 'Pour chaque Fichier du Dossier "__MACOSX"
   ''._Keywordsuggest - piece detachee voiture - 2021-01-26 exemple de Nom
       If f.Name Like "._Keywordsuggest -*" Then  'si le Nom de ce Fichier à la forme "._Keywordsuggest
                fFile = FreeFile
            Debug.Print f.Name 'Pour le Test On imprime son Nom dans la fenêtre "Exécution"
            FileCsv = StrFolder & "\" & f.Name 'oN constitue le Chemin au Fichier
        Open FileCsv For Input As #fFile 'on ouvre le Fichier pour lecture peut être modifier For Input en Binary
                               Do Until EOF(1) 'on va Boucler jusqu'a la derniere ligne du fichier
                                  Line Input #fFile, LineFromFile 'on récupére la ligne
                                   LigneCible = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'On définit la première ligne Vide depuis la Colonne 1
                                                        .Cells(LigneCible, 1) = Trim(LineFromFile)  'Oncolle la Ligne
                                Loop
                   Close #fFile
     End If
    Next
        .Cells.Columns.AutoFit
End With
   Set FileCsv = Nothing
   Set objFSO = Nothing
   Set FileCsv = Nothing
   Set objFolder = Nothing
End Sub
a adapter surement Lol
je ne sais pas s'il y a un délimiteur et lequel
je ne suis pas sous Mac (extraction de Text Bizard Lol)
jean marie
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour jnce84, ChTi160, dysor,

Téléchargez les fichiers zippés joints dans le même dossier, ouvrer Assemblage(1).xlsm et exécutez :
VB:
Sub Assembler()
'se lance par les touches Ctrl+M
Dim chemin$, fichier$, lig&, P As Range, h&, i%
chemin = ThisWorkbook.Path & Application.PathSeparator
fichier = Dir(chemin) '1er fichier
lig = 1
Application.ScreenUpdating = False
With Feuil1 'CodeName à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtr"e
    .Cells.Delete 'RAZ
    While fichier <> ""
        If fichier Like "*.csv" Then
            Workbooks.OpenText chemin & fichier, Local:=True 'ouvre le fichier CSV
            Set P = ActiveSheet.UsedRange.EntireRow
            h = P.Rows.Count
            P.Copy .Cells(lig, 1) 'copier-coller
            .Cells(lig, 1).Resize(h).TextToColumns .Cells(lig, 1), xlDelimited, Semicolon:=True 'commande Convertir, sépateur point-Virgule
            lig = lig + h
            ActiveWorkbook.Close 'ferme le fichier CSV
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .UsedRange
        ReDim a(.Columns.Count - 1) 'base 0
        For i = 0 To UBound(a): a(i) = i + 1: Next
        .RemoveDuplicates a, Header:=xlNo 'supprime les lignes en doublon (titres)
    End With
    With .UsedRange
        .Replace "é", "é", xlPart
        .Replace "è", "è"
    End With
    .Rows(1).Font.Bold = True 'gras
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub
La macro fonctionne bien sur les 3 fichiers du même dossier.

Par contre elle ne va pas sur ceux du dossier _MACOSX, ils sont trop tordus.

A+
 

Pièces jointes

  • Archive.zip
    73.8 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 896
Membres
101 833
dernier inscrit
sandra25