Compléter un tableau Excel depuis des fichiers Excels
Bonjour,
Je souhaite compléter automatiquement les lignes du Fichier : Fichier tableau issu du cumul de fichier base, à partir des informations du Fichier : Fichier base.
Il faut bien entendu que les informations rapportées sur le Fichier : Fichier tableau issu du cumul de fichier base, viennent se mettre les unes à la suite des autres sans les écraser après chaque enregistrement.
Le nom du Fichier : Fichier base sera différent à chaque fois. Je souhiate pouvoir sélectionner soit le dossier où ces fichiers Excel se trouvent, soit plusieurs fichiers à la fois et ensuite lancer le traitement (remplissage du Fichier : Fichier tableau issu du cumul de fichier base).
PS : Les informations à rapportées sont soit du texte soit le texte se trouvant à gauche d'une cellule marquée d'un X. Attention, si pour une meme caractéristique (Caractéristique 1 par exemple), les deux cellules de gauche doivent s'affichées et etre rapportées).
Si vous souhaitez plus d'informations n'hésitez pas.
Par avance, un grand merci.
Bonjour,
Le problème que tu soumet est plutôt typique d'une base de données que d'excel. As tu envisagé l'utilisation d'un SGBD pour construire ton tableau de données cible ?
Sinon VBA devrait pouvoir t'aider à faire ce que tu veux, regarde les fonctions macro d'ouverture de fichiers (pour tes fichiers de données base) et les fonctions de recherche et sélection (pour lire les données, sélectionner une ligne vide et filtrer sur tes critères). Tu dois pouvoir réaliser un petit script qui va chercher tes fichiers bases en paramètres, lit leur contenu enregistrement par enregistrement (une ligne de ton tableau cible), contrôle ce contenu et l'inscrit dans une nouvelle ligne de ton tableau cible.
Si cela peut t'aider à avancer, Cordialement
Merci d'avoir pris le temps de t'interesser à mon sujet.
En revanche, je suis novice dans la programmation VBA, donc malgré tes conseils je ne suis pas plus avancé. Peux tu m'écrire le code VBA ?
Salutations.
Voici un code, le dossier à sélectionner ne doit évidemment contenir que les fichiers de base (toujours identiques).
Sub traiter()
Dim fso, fichier, fichiers
Dim wkb As Workbook
Dim choix_chemin As FileDialog
Dim ligne_copie As Long
' Récupération des répertoires
Set choix_chemin = Application.FileDialog(msoFileDialogFolderPicker)
choix_chemin.Show
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(choix_chemin.SelectedItems(1))
Set fichiers = Dossier.Files
Set choix_chemin = Nothing
' Boucle sur les fichiers
For Each fichier In fichiers
Set wkb = Workbooks.Open(fichier)
ligne_copie = ThisWorkbook.Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1
With ThisWorkbook.Worksheets("Feuil1")
.Range("A" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B2").Value
.Range("B" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B3").Value
.Range("C" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B4").Value
.Range("D" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B5").Value
.Range("E" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B6").Value
For ligne = 8 To 10
If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
.Cells(ligne_copie, 6).Value = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
Exit For
End If
Next
For ligne = 12 To 13
If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
.Cells(ligne_copie, 7).Value = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
Exit For
End If
Next
End With
wkb.Close
Set wkb = Nothing
Next
Set fso = Nothing
Set Dossier = Nothing
Set fichiers = Nothing
End Sub
Un grand merci ca marche super, sauf que si je coche deux Cellule dans Caractéristiques 1, genre Poire et Pomme, dans la macro envoyée, il n'y a que une info qui s'affiche. Est il possible de les faire apparaitre ainsi : Poire / Pomme. Meme chose pour Caractéristiques 2.
Encore merci de prendre le temps de répondre.
Code modifié :
Sub traiter()
Dim fso, fichier, fichiers
Dim wkb As Workbook
Dim choix_chemin As FileDialog
Dim ligne_copie As Long
Dim fruit As String
' Récupération des répertoires
Set choix_chemin = Application.FileDialog(msoFileDialogFolderPicker)
choix_chemin.Show
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(choix_chemin.SelectedItems(1))
Set fichiers = Dossier.Files
Set choix_chemin = Nothing
' Boucle sur les fichiers
For Each fichier In fichiers
Set wkb = Workbooks.Open(fichier)
ligne_copie = ThisWorkbook.Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1
With ThisWorkbook.Worksheets("Feuil1")
.Range("A" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B2").Value
.Range("B" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B3").Value
.Range("C" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B4").Value
.Range("D" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B5").Value
.Range("E" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B6").Value
fruit = ""
For ligne = 8 To 10
If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
If fruit = "" Then
fruit = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
Else: fruit = fruit & " / " & wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
End If
End If
Next
.Cells(ligne_copie, 6).Value = fruit
fruit = ""
For ligne = 12 To 13
If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
If fruit = "" Then
fruit = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
Else: fruit = fruit & " / " & wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
End If
End If
Next
.Cells(ligne_copie, 7).Value = fruit
End With
wkb.Close
Set wkb = Nothing
Next
Set fso = Nothing
Set Dossier = Nothing
Set fichiers = Nothing
End Sub
J'espère que ça répond à ta demande
Super, un grand merci.
Ca fonctionne nickel !
Raf a écrit :Merci d'avoir pris le temps de t'interesser à mon sujet.
En revanche, je suis novice dans la programmation VBA, donc malgré tes conseils je ne suis pas plus avancé. Peux tu m'écrire le code VBA ?
Salutations.
Tu l'as demandé, Migou la fait.
Beau travail Migou.
Si c'est OK pour toi, Raf, clos le sujet (la petite coche à côté du bouton éditer), il servira de référence à d'autres.
Cordialement,
PhilParis
PhilParis a écrit :Raf a écrit :Merci d'avoir pris le temps de t'interesser à mon sujet.
En revanche, je suis novice dans la programmation VBA, donc malgré tes conseils je ne suis pas plus avancé. Peux tu m'écrire le code VBA ?
Salutations.
Tu l'as demandé, Migou la fait.
Beau travail Migou.
Si c'est OK pour toi, Raf, clos le sujet (la petite coche à côté du bouton éditer), il servira de référence à d'autres.
Cordialement,
PhilParis
Merci PhilParis