Importer plusieurs classeurs d'un même dossier et coller les données dans une feuille

[robby98800]

Bonjour,
J’ai un problème que je n’arrive pas à résoudre à l’aide d’ancien post et je n’ai pas les outils nécessaire pour le faire tout seul.
Je vous explique mon problème, je cherche à importer plusieurs classeurs qui sont compris dans le même dossier. L’idéal serait de choisir le dossier en dynamique avec un fenêtre Ouvrir.
Le nom de chaque classeur est différent par contre à l’intérieur les données sont rangées de la même manière. Il faut surement faire une boucle pour récupérer tous les classeurs dans le dossier.

Les classeurs a importé sont en .csv mais les données ne sont pas séparées par un séparateur justement ! En gros ils sont ouvert par Excel pour reste en .csv. Quand j’ouvre un fichier avec Application.Dialogs(xlDialogOpen).Show ça ne marche pas. Je ne sais pas trop comment faire, c’est du csv mais pas vraiment…

Si cela n’est pas possible au pire c’est pas grave je le convertirai manuellement avant de faire l’importation.
Voici la macro qui me permet d’importer un classeur en xlsx (ensuite je prend une certaines plage et juste les cellules qui répondent à une condition mais ça je me débrouillerai pour le faire tout seul)

Sub Importer()
Dim ladate As Date, Plage As Range

derli = Sheets("releve_erreur").Range("A" & Rows.Count).End(xlUp).Row 'definit la derniere ligne de la colonne A
ladate = DateAdd("d", -7, Date)

Set Destination = ActiveWorkbook
 
Source = Application.Dialogs(xlDialogOpen).Show 'permet de choisir un dossier dans une fenêtre ouvrir
    If Source = False Then
        MsgBox ("Aucun fichier sélectionné")
            Exit Sub
    Else
        Set Source = ActiveWorkbook

Source.Activate
Sheets(1).Select
           
        For i = 2 To Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
            If Sheets(1).Range("A" & i).Value >= ladate Then
                If Plage Is Nothing Then
                    Set Plage = Sheets(1).Range("A" & i & ":" & "E" & i)
                Else
                    Set Plage = Union(Plage, Sheets(1).Range("A" & i & ":" & "E" & i))
                End If
            End If
        Next
  
Destination.Activate
Sheets("releve_erreur").Range("A2:E" & derli).ClearContents
Plage.Copy Destination:=Sheets(2).Range("A2")

Source.Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
        
    End If
 
End Sub

Merci beaucoup de votre aide !

 

[robby98800]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Oulala, vraiment désolé je viens de m'apercevoir que je travaillais encore avec l'ancienne macro. La nouvelle fait exactement ce que je voulais.
Merci encore Yaloo, c'est vraiment super ce que tu as fait.

A+

Robin

 

[Yaloo]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour robby,

Voici le fichier avec les 2 possibilités :

- Soit fichier par fichier
- Soit tous les fichiers se trouvant dans le même répertoire que le fichier destination.

A+

PS : ne pas oublier de changer les dates (pour les essais j'ai mis date -75)

 

[robby98800]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Merci c'est parfait,

A+

 

[Staple1600]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour à tous

Un autre approche:
1) renommer tes *.csv en *.txt
(un simple batch MSDOS peut suffire:
@ren *.csv *.txt
(batch que tu peux lancer par VBA, mais tu peux aussi les renommer par VBA et/ou Vbscript adapté à VBA : Ce lien n'existe plus )

2) En adaptant cet exemple testé sur ton fichier exemple Source.csv

Sub Macro1()
' Macro1 Macro -> obtenu avec l'enregisteur de macro ;-)
' Macro enregistrée le 08/07/2012 par Staple
    Workbooks.OpenText Filename:="E:\Source\Source.txt", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
        , Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
End Sub

Sub Macro1B()
Dim sChem$
sChem = "E:\Source\"
    Workbooks.OpenText _
                Filename:=sChem & "Source.txt", _
                Origin:=xlMSDOS, _
                StartRow:=1, _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=False, _
                Semicolon:=True, _
                Comma:=False, _
                Space:=False, _
                Other:=False, _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                TrailingMinusNumbers:=True
End Sub

robby98800
Puisque que tu disposes du code VBA nécessaire pour boucler sur tous les *.csv d'un répertoire, je te laisse tester plus avant cette proposition.

PS: Si tu es intéressé, je reviendrai voir ce qu'aura donné tes tests, et en cas de souci, je te filerai un petit coup de main dominical

 

[Staple1600]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Re, bon dimance à tous

Les dimanches d'après teuf, rien de mieux que le regexp et le oFSO pour vous enlever une céphalée carabinée
Et comme en plus, ma télé ne m'inspire pas confiance à cette heure

Donc, puisque mes mimines ont travaillé le jour du seigneur, je poste le code
(test Ok sur mon PC: mettre la bonne lettre de lecteur et le bon nom de dossier avant de tester)
Je n'ai pas fait la macro pour ouvrir tous les *.csv (ici renommés en *.txt)
Je garde cela pour tantôt, après le déjeuner léger - sauf s'il me prend l'envie subite de regardes des gars pédaler sur les routes de France.

Sub traitement()
RenommerCSVenTXT
Macro1B
End Sub

Sub RenommerCSVenTXT()
'Déclarations
Dim objFSO, fichier, NomReP, objDossier, ListFichiers, objRegExp, NouvFichier
'utlisation de l'objet Scripting.FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject"): NomReP = "E:\Source\"
Set objDossier = objFSO.GetFolder(NomReP): Set ListeFichiers = objDossier.Files
'utilisation de RegExp pour identifier l'extension *.csv
With CreateObject("vbscript.regexp")
    .Pattern = "^(.*\.)csv": .IgnoreCase = True
    For Each fichier In ListeFichiers 'boucle sur tous les *.csv du dossier
        If .Test(fichier.Name) Then 'si l'extension est bien .csv alors
            NouvFichier = .Replace(fichier.Name, "$1txt") ' création d'un String avec l'extention txt
            objFSO.MoveFile fichier, NomReP & NouvFichier 'renomme les *.csv en *.txt
        End If
    Next
End With
End Sub

Sub Macro1B()
Dim sChem$
sChem = "E:\Source\"
    Workbooks.OpenText _
                Filename:=sChem & "Source.txt", _
                Origin:=xlMSDOS, _
                StartRow:=1, _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=False, _
                Semicolon:=True, _
                Comma:=False, _
                Space:=False, _
                Other:=False, _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                TrailingMinusNumbers:=True
End Sub

 

[robby98800]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour Staple1600,

Oui merci ta méthode marche super bien aussi!

A+

Robin

 

[robby98800]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour Yaloo,

Je reviens vers toi car j'ai un problème sur la macro que tu avais faite qui fonctionnait très bien jusqu'à maintenant. Quand on importe trop de données, il se produit une erreur due a

Application.WorksheetFunction.Transpose

qui a depassé la limite de colonne.

Y-aurait il un moyen d'importer le csv et de remplir le array en ligne, sans utiliser la transposée?

Merci,

Robin

 

[Staple1600]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour


Comme tu le dis toi-même pourquoi ne pas utiliser ceci
https://www.excel-downloads.com/thr...t-coller-les-donnees-dans-une-feuille.187873/

EDITION: Bonjour Yaloo

 

[Yaloo]

Re : Importer plusieurs classeurs d'un même dossier et coller les données dans une fe

Bonjour Robby, Staple, le forum,

Si la taille limite est atteinte, il n'y a pas grand chose à faire, la solution de Staple me semble la plus judicieuse, passer sur un format txt.

A+