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

[jnce84]

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.

 

[ChTi160]

Bonjour
une première approche pour lister les Fichiers présents dans le Dossier des Archives

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

 

[dysorthographie]

Bonjour,
CreateObject("Scripting.FileSystemObject") c'est compatible MAC?

 

[ChTi160]

Bonjour.
Ben ca ! c'est une bonne question lol
moi pas savoir lol
Merci de ton intervention .
En cherchant ,je vais trouver lol
bonne journée à toi
Jean marie

 

[ChTi160]

Re apparemment non lol
Voir ici
jean marie

 

[job75]

Bonjour jnce84, ChTi160, dysor,

Téléchargez les fichiers zippés joints dans le même dossier, ouvrer Assemblage(1).xlsm et exécutez :

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+

 

[Staple1600]

Bonjour le fil

[Juste de passage et pour infos]

Bonjour,
CreateObject("Scripting.FileSystemObject") c'est compatible MAC?

la réponse est non
Ne tourne que sur Windows.
[/Juste de passage et pour infos]

EDITION
Houps, désolé ChTi160, je n'avais vu le petit message avec le lien
(message#5)

 

[ChTi160]

Bonjour les jeunes LOL
J'esperai bien que Job75 passe par là lol
merci a vous!
Un coucou particulier à JM !
Jean marie

 

[jnce84]

Bonjour à tous,
Merci beaucoup pour vous êtes empressés de m'aider ! Job75 toujours au top de sa forme on dirait