Sujet Précédent Sujet Suivant

Comment ouvrir plusieurs fichiers excel dans un même classeur pour ensuite les c

Résolu
cs_Anatolle Messages postés 4 Date d'inscription lundi 2 octobre 2006 Statut Membre Dernière intervention 24 octobre 2006 - 4 oct. 2006 à 19:35
cs_Anatolle Messages postés 4 Date d'inscription lundi 2 octobre 2006 Statut Membre Dernière intervention 24 octobre 2006 - 5 oct. 2006 à 23:53
Salut à tous,

Je suis un débutant en VBA et je dois faire un petit logiciel pour traiter des fichiers de données .txt dans excel. Je me demandais s'il n'y avait pas quelqu'un qui saurait comment ouvrir plusieurs fichiers excel en VBA pour ensuite les concaténer?!

Avec le code suivant, je suis capable de rechercher le nombre de fichiers dans le dossiers des données à traiter, de les ouvrir un par un (manuellement en spécifiant quelques paramètres,... ce que j'aimerais automatiser), et de les concaténer. De plus, je veux effectuer un trie dans les données afin que le titre des collonnes n'apparaissent qu'une fois et que les tuples affichant la valeur 0 soient supprimer. Alors le voici:

Private Sub RDS_INNOTAG_Click()


Set fichcherche = Application.FileSearch
With fichcherche


.LookIn = "C:\Club Passion\données Innotag"  'dossier où se trouve les données
.Filename = "*.X02"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " Fichier(s) a (ont) été trouvé(s)."
For I = 1 To .FoundFiles.Count  'trouve le nombre de fichiers
Workbooks.OpenText Filename:=.FoundFiles(I), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=True, OtherChar:="@", FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True ' à cause de la méthode d'ouverture ReponseDialog plus basse, 'les paramètres ne sont pas respectés
       
passed = 0
Do
         ReponseDialog = Application.Dialogs(xlDialogOpen).Show("C:\Club Passion\Données Innotag\*.X02")        If ReponseDialog False Then Parcour False: Exit Do 'seule façon que j'ai trouvé pour les 'ouvrir pour rendre la concaténation possible    
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "RECORD"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "WIDTH"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "SPOT_YLD_W"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "SPOT_YLD_T"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "RDMRNT_SEC"
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    Selection.Cut
    Range("D1").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    Selection.Cut
    Range("E1").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "MOISTURE"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "HUMIDITE"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "LOG_YLD_WE"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "LAT"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "LOG"
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "LATITUDE"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "LONGITUDE"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "FIX_STATUS"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "TAG_STATUS"
    Columns("O:Q").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-6
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/1000000"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/1000000"
    Range("K2").Select
    Selection.Copy
    Range("K3").Select
    ActiveWindow.ScrollRow = 20684
    Range("K3:K20686").Select
    ActiveSheet.Paste
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L3").Select
    ActiveWindow.ScrollRow = 20684
    Range("L3:L20686").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=3
    Columns("M:N").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0"
    Columns("K:L").Select
    Selection.NumberFormat = "0.000000"
    ActiveWindow.SmallScroll ToRight:=-3
    Columns("I:J").Select
    Selection.NumberFormat = "0"
    Columns("H:H").Select
    Selection.NumberFormat = "0"
    ActiveWindow.SmallScroll ToRight:=-3
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/100"
    Range("G2").Select
    Selection.Copy
    Range("G3").Select
    ActiveWindow.ScrollRow = 20684
    Range("G3:G20686").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.00"
    Columns("F:F").Select
    Selection.NumberFormat = "0"
    Columns("B:C").Select
    Selection.NumberFormat = "0"
    Columns("D:E").Select
    Selection.NumberFormat = "0.00"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/100"
    Range("D3").Select
    ActiveWindow.SmallScroll ToRight:=1
    Range("D2").Select
    Selection.Copy
    Range("D3").Select
    ActiveWindow.ScrollRow = 20684
    Range("D3:D20686").Select
    ActiveSheet.Paste
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]*(100-RC[2])/85.5"
    Range("E2").Select
    Selection.Copy
    Range("E3").Select
    ActiveWindow.ScrollRow = 20684
    Range("E3:E20686").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollRow = 20684
    ActiveWindow.ScrollRow = 15322
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveWindow.SmallScroll ToRight:=-1
    Range("A1").Select
            If passed 0 Then myfile ActiveWorkbook.Name
    If passed > 0 Then
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(myfile).Activate
    ActiveSheet.Paste
    End If
        
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    passed = passed + 1
Loop


    Range("A2").Select
    Application.CutCopyMode = False
    nouveau = InputBox("Assignez un nom au fichier concaténé.", "Nouveau fichier")
    ActiveWorkbook.SaveAs Filename:="C:\Club Passion\Excel" & nouveau & ".xls", FileFormat:=xlText, _
        CreateBackup:=False
        
    Do
    ActiveWorkbook.Close False ' J'aimerais pouvoir faire en sorte que l'application ne se ferme 'plus, mais si j'enlève cette partie du code, il y a une erreur dans les boucles lors de la compilation
    passed = passed - 1
    If passed = 0 Then Exit Do
    Loop


On Error Resume Next
Next I
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With


End Sub

Voilà, je sais que mon code est très long et que ce que je vous demande est assez compliqué,... mais je suis un peu désespéré , je ne sais plus quoi essayé!!

Merci à l'avance et bonne journée !!!

5 réponses

Réponse 1 / 5
cs_Anatolle Messages postés 4 Date d'inscription lundi 2 octobre 2006 Statut Membre Dernière intervention 24 octobre 2006
5 oct. 2006 à 23:53
Ça plantait après la copie du premier,... mais j'ai travaillé toute la journée dessus et j'ai finalement opté pour une autre alternative: après l'ouverture de mes fichiers .X02, je les rend conforme en modifiant leurs paramètres, puis je les enregistre en format .txt et les referme. Je me suis fait alors une autre Macro pour les concaténer à partir d'un bouton d'activation indépendant... et ça fonctionne!!!! Merci beaucoup pour ton intérêt MPi! voici mon code:

Private Sub RDS_INNOTAG_Click()


Set fichcherche = Application.FileSearch
With fichcherche


' .LookIn = GetDirectory  'Utilise la fonction GetDirectory voir page Exemple d'application
.LookIn = "C:\Club Passion\données Innotag"  'dossier où se trouve les données
.Filename = "*.X02"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " Fichier(s) a (ont) été trouvé(s)."
For I = 1 To .FoundFiles.Count 'trouve le nombre de fichiers
Workbooks.OpenText Filename:=.FoundFiles(I), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=True, OtherChar:="@", FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True  'paramètres pour rendre le fichier txt conforme en excel
        
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "RECORD"
     ' ... j'ai deleter une partie car c'est un peu long
    ActiveWindow.ScrollRow = 20684
    ActiveWindow.ScrollRow = 15322
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveWindow.SmallScroll ToRight:=-1
    Range("A1").Select
   
    Range("A1").Select
    Application.CutCopyMode = False
    nouveau = InputBox("Assignez un nom au fichier texte.", "Nouveau fichier")
    ActiveWorkbook.SaveAs Filename:="C:\Club Passion\Données Innotag" & nouveau & ".txt", FileFormat:=xlText, _
        CreateBackup:=False
    ActiveWorkbook.Close


On Error Resume Next
Next I
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With


End Sub


Private Sub Concatenation_Click() 'début de la étape Concaténation


passed = 0
Do
         ReponseDialog = Application.Dialogs(xlDialogOpen).Show("C:\Club Passion\Données Innotag\*.txt")        If ReponseDialog False Then Parcour False: Exit Do    If passed 0 Then myfile ActiveWorkbook.Name
    If passed > 0 Then
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(myfile).Activate
    ActiveSheet.Paste
    End If
       
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    passed = passed + 1
Loop


    Range("A1").Select
    Application.CutCopyMode = False
    nouveau = InputBox("Assignez un nom au fichier concaténé.", "Nouveau fichier")
    ActiveWorkbook.SaveAs Filename:="C:\Club Passion\Excel" & nouveau & ".xls", FileFormat:=xlText, _
        CreateBackup:=False
    Do
    ActiveWorkbook.Close False
    passed = passed - 1
    If passed = 0 Then Exit Do
    Loop


End Sub
3
Réponse 2 / 5
cs_Anatolle Messages postés 4 Date d'inscription lundi 2 octobre 2006 Statut Membre Dernière intervention 24 octobre 2006
4 oct. 2006 à 20:35
J'ai réussi à faire un peu de ménage dans mon programme, il est un peu plus claire maintenant. Donc ce qu'il fait maintenant : il trouve le nombre de fichier dans le dossier, ouvre le premier et le met en ordre, il vient pour chercher les autres fichiers afin de les concaténer, et c'est là qui plante... Si jamais il y a quelqu'un qui voudrait m'aider, ce serait GRANDEMENT apprécié ;) 

Private Sub RDS_INNOTAG_Click()


Set fichcherche = Application.FileSearch
With fichcherche


.LookIn = "C:\Club Passion\données Innotag"  'dossier où se trouve les données
.Filename = "*.X02"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " Fichier(s) a (ont) été trouvé(s)."
For I = 1 To .FoundFiles.Count 'indique le nombre de fichiers de données
myfile = ActiveWorkbook.Name
Workbooks.OpenText Filename:=.FoundFiles(I), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=True, OtherChar:="@", FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True  'paramètres pour rendre le fichier txt conforme en excel
   
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "RECORD"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "WIDTH"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "SPOT_YLD_W"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "SPOT_YLD_T"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "RDMRNT_SEC"
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    Selection.Cut
    Range("D1").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    Selection.Cut
    Range("E1").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "MOISTURE"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "HUMIDITE"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "LOG_YLD_WE"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "LAT"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "LOG"
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "LATITUDE"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "LONGITUDE"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "FIX_STATUS"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "TAG_STATUS"
    Columns("O:Q").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-6
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/1000000"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/1000000"
    Range("K2").Select
    Selection.Copy
    Range("K3").Select
    ActiveWindow.ScrollRow = 20684
    Range("K3:K20686").Select
    ActiveSheet.Paste
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L3").Select
    ActiveWindow.ScrollRow = 20684
    Range("L3:L20686").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=3
    Columns("M:N").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0"
    Columns("K:L").Select
    Selection.NumberFormat = "0.000000"
    ActiveWindow.SmallScroll ToRight:=-3
    Columns("I:J").Select
    Selection.NumberFormat = "0"
    Columns("H:H").Select
    Selection.NumberFormat = "0"
    ActiveWindow.SmallScroll ToRight:=-3
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/100"
    Range("G2").Select
    Selection.Copy
    Range("G3").Select
    ActiveWindow.ScrollRow = 20684
    Range("G3:G20686").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.00"
    Columns("F:F").Select
    Selection.NumberFormat = "0"
    Columns("B:C").Select
    Selection.NumberFormat = "0"
    Columns("D:E").Select
    Selection.NumberFormat = "0.00"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/100"
    Range("D3").Select
    ActiveWindow.SmallScroll ToRight:=1
    Range("D2").Select
    Selection.Copy
    Range("D3").Select
    ActiveWindow.ScrollRow = 20684
    Range("D3:D20686").Select
    ActiveSheet.Paste
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]*(100-RC[2])/85.5"
    Range("E2").Select
    Selection.Copy
    Range("E3").Select
    ActiveWindow.ScrollRow = 20684
    Range("E3:E20686").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollRow = 20684
    ActiveWindow.ScrollRow = 15322
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    Range("B1").Select
    ActiveWindow.SmallScroll ToRight:=-1
    Range("A1").Select
  Do    If passed 0 Then myfile ActiveWorkbook.Name
    If passed > 0 Then
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(myfile).Activate
    ActiveSheet.Paste
    End If
       
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select 'cette partie cause problème
    passed = passed + 1
Loop


    Range("A2").Select
    Application.CutCopyMode = False
    nouveau = InputBox("Assignez un nom au fichier concaténé.", "Nouveau fichier")
    ActiveWorkbook.SaveAs Filename:="C:\Club Passion\Excel" & nouveau & ".xls", FileFormat:=xlText, _
        CreateBackup:=False




On Error Resume Next
Next I
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With


End Sub
0
Réponse 3 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
5 oct. 2006 à 00:26
As-tu essayé avec

ActiveSheet.PasteSpecial

plutôt que

ActiveSheet.Paste   ?

MPi
0
Réponse 4 / 5
cs_Anatolle Messages postés 4 Date d'inscription lundi 2 octobre 2006 Statut Membre Dernière intervention 24 octobre 2006
5 oct. 2006 à 14:40
J'avoue que le PasteSpecial est une bonne idée, mais ça n'a rien changé, mon programme bug toujours au même endroit, c'est-à-dire lorsqu'il sélectionne la cellule du prochain collage:

ActiveCell.Offset(1, 0).Select
...

Merci MPi pour ton conseil,

Est-ce que quelqu'un aurait une autre idée?!
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
5 oct. 2006 à 23:28
Et c'est où que ça plante ? avant ou après la copie du premier fichier.

Y a-t-il un numéro d'erreur et une description de cette erreur ?

MPi
0

Discussions similaires

Ouvrir un classeur Excel par macro sans l'afficher
maxxyme -
rvblog -

12 réponses
Fichier tar.gz
sousoulebarbu -
sousoulebarbu -

14 réponses
Ouvrir et traiter un ficher .csv sous excel en VBA
kyoleroi -
kyoleroi -

5 réponses
ouvrir un fichier pdf en vba sous excel
lebpoussin -
mascio -

4 réponses
Extraire une donnée d'une cellule excel avec python
pascal128 -
pascal128 -

3 réponses
Rejoignez-nous