Extraction de donnees plusieurs fichiers xl / Macro / VBA

Repokovski

XLDnaute Nouveau
Bonjour,

Je débute dans le monde de VBA et je viens soliciter votre aide.
Voici mon problème : J'ai une trentaine de fichiers identitiques par la structure, différents par les données, et je dois récupérer uniquement les valeurs de quelques cellules pour en créer un tableau récapitulatif.
L'avantage de ces fichiers c'est qu'ils utilisent la meme charte, les memes numero de compte et les memes numeros d'usine (pour simplifier l'explication, on dira que ce sont des usines).
POur illustrer mon propos, je vous joins 4 fichiers. Les 3 premiers sont les tableaux sources, le fichier 5 est la synthese de ce que je souhaite obtenir.

Votre aide me serait plus que précieuse ...
Merci d'avance !

Cdlt
 

Pièces jointes

  • New Folder.zip
    38.7 KB · Affichages: 56
  • New Folder.zip
    38.7 KB · Affichages: 57
  • New Folder.zip
    38.7 KB · Affichages: 59
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonsoir Repokovski, bonsoir le forum,

Écrire le code d'une procédure requiert beaucoup de précision pour éviter le moindre bug. Une trentaine c'est vraiment pas précis ! Tous les fichiers se trouvent-ils dans le même dossier ? Qu'ont-ils de commun dans leur nom ? Autant de questions qui nécessitent des réponse précises pour commencer un code sérieux...
 

Repokovski

XLDnaute Nouveau
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Merci Robert pour ce retour,

Il y a 26 fichiers xl, ils se trouvent tous dans un meme dossier. Leur nom differe en fonction du mois.
Mais si vous pouviez me donner quelques pistes rien qu'avec l'exemple que j'ai fourni, ce serait deja beaucoup.
A partir de la, je pourrais l'adapter a ma situation

Merci bcp
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonsoir Repokovski, bonsoir le forum,

dans ton exemple la structure n'est pas toujours la même...
• L'onglet de travail du classeur Book2.xlsx se nomme Sheet1, le tableau va jusqu'à la ligne 30
• L'onglet de travail du classeur Book3.xlsx se nomme Sheet2, le tableau va jusqu'à la ligne 30
• L'onglet de travail du classeur Book4.xlsx se nomme Sheet1, le tableau va jusqu'à la ligne 29
Le code que je te propose semble fonctionner malgré ce b... J'ai utilisé une boucle pour ouvrir les classeurs et dans la variable dec récupérer l'incrément de cette boucle. Tu adapteras car j'ai utilisé comme base tes fichiers exemples.

Le code commenté que j'ai placé dans le classeur de destination Book5.xlsm (dans ton exemple comme il n'avait pas de macro il se nommait Book5.xlsx) :
Code:
Public Sub Recup()
Dim cd As Workbook 'déclare la variable cd (Classeur de Destination)
Dim ch As String 'déclare la variable ch (CHemin d'accès)
Dim od As Object 'déclare la variable od (Onglet de Destination)
Dim i As Byte 'déclare la variable i (Incrément)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim dec As Byte 'déclare la variable dec (DECalage)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim nru As String 'déclare la variable nru (Numéro de RU)
Dim li As Byte 'déclare la variable li (LIgne)
Dim col As Byte 'déclare la variable col (COLonne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set cd = ThisWorkbook 'définit le classeur de destination cd
ch = cd.Path & "\" 'définit le chemin d'accès CH
Set od = cd.Sheets("Sheet1") 'définit l'onglet de destination od
For i = 2 To 4 'boucle 1 : sur les 3 classeurs source
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Workbooks("Book" & i & ".xlsx").Activate 'active le classeur source (génère une erreur s'il n'est pas ouvert)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err = 0 'annule l'erreur
        Workbooks.Open (ch & "Book" & i & ".xlsx") 'ouvre le classeur
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set cs = ActiveWorkbook 'définit la classeur source cs
    Set os = cs.Sheets(1) 'définit l'onglet source os
    dec = i - 1 'définit le décalage de colonne dec
    Set pl = os.Range("A2:P30") 'définit la plage pl
    'boucle 2 : sur toutes les cellules cel de la colonne B de l'onglet de destination
    For Each cel In od.Range("B5:B" & od.Cells(Application.Rows.Count, 2).End(xlUp).Row)
        If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
            nru = cel.CurrentRegion.Cells(1, 2).Value 'récupère le numéro de Ru
            'récupère la ligne correspondante à la celluel dans la plage pl
            li = Application.Intersect(pl, os.Columns(1)).Find(cel.Value, , xlValues, xlWhole).Row
            'récupère la colonne correspondante au numéro de Ru dans la plage pl
            col = Application.Intersect(pl, os.Rows(2)).Find(nru, , xlValues, xlWhole).Column
            'renvoie dans la cellule cel, décalée de dec colonnes à droite, le resultat de la cellule ligne li colonne col de la plage pl
            cel.Offset(0, dec).Value = Round(os.Cells(li, col).Value, 0)
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle 2
    cs.Close Savechanges:=False 'ferme le classeur source sans enregistrer
Next i 'prochain classeur de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 

Repokovski

XLDnaute Nouveau
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Robert,

Ca marche parfaitement. Je vais utiliser ce code pour m'entrainer et puis l'adapter a d'autres fichiers.
Merci pour les commentaires a chaque lignes.

Merci pour votre aide, comme toujours tres precieuse sur ce forum.

Bonne journee ;)
 

Repokovski

XLDnaute Nouveau
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonjour,

Bon, comme je debute, je dois vous avouer que je ne comprends pas tout, et c'est un euphemisme ^^. J'aurais du y aller step by step.
Ce que je ne comprends pas tout d'abord c'est comment vous faites pour renvoyer au tableau final les informations recherchees.
J'utilise en general un "vlookup" ou bien un "index+equiv" mais la ce n'est pas possible.
Pouvez vous m'expliquer avec un exemple plus simple (cf fichier XL fourni) en utilisant VBA.

Merci pour votre aide.
 

Pièces jointes

  • Bookexemplesimple.zip
    14.2 KB · Affichages: 53

Robert

XLDnaute Barbatruc
Repose en paix
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonsoir Repokovski, bonsoir le forum,

un code adapté à ton exemple... J'utilise la fonction Find, qui correspond au Rechercher d'Excel, pour récupérer les numéros de ligne et de colonne. On pourrait tout aussi bien utiliser Index et Equiv mais comme je maîtrise mal ces formules le ne les utilisent pas dans mes codes VBA. Il y a, bien sûr, plusieurs méthodes pour arriver au même résultat et chacun utilise celle qui lui convient le mieux...

Le code :
Code:
Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim ac As String 'déclare la variable ac (AC)
Dim ru As String 'déclare la variable ru (RU)
Dim li As Byte 'déclare la variable li (LIgne)
Dim col As Byte 'déclare la variable col (COLonne)

For Each cel In Range("C4:E7") 'boucle sur toutes les cellules cel de la plage C4:E7
    ac = Cells(cel.Row, 2).Value 'définit la variable ac (valeur de la cellule dans la même ligne que cel, dans la colonne 2 = B)
    ru = Cells(3, cel.Column) 'définit la variable ru (valeur de la ligne 3, dans la même colonne que cel)
    'définit la recherche r (recherche dans la plage H4:H30 la valeur de ac en entier)
    Set r = Range("H4:H30").Find(ac, , xlValues, xlWhole)
    'si au moins une occurrence est trouvée, récupère son numéro de ligne dans la variable li, sinon message et sort de la procédure
    If Not r Is Nothing Then li = r.Row Else MsgBox "AC non trouvé": Exit Sub
    'redéfinit la recherche r (recherche dans la plage I3:O3 la valeur ru en entier)
    Set r = Range("I3:O3").Find(ru, , xlValues, xlWhole)
    'si a moins une occurrence est trouvée, récupère son numéro de colonne dans la variable col, sinon message et sort de la procédure
    If Not r Is Nothing Then col = r.Column Else MsgBox "RU non trouvé": Exit Sub
    'envoie dans la cellule cel la valeur de la cellue en ligne li, colonne col
    cel.Value = Cells(li, col).Value
Next cel 'prochaine cellule de la boucle
End Sub
 

Repokovski

XLDnaute Nouveau
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonjour,

Merci beaucoup,

Derniere question :
Imaginons que mes tableaux sources soient dans des onglets differents que mon tableau de destination (tout en restant dans le meme classeur).
J'ai essaye de les declarer comme vous aviez fait auparavant, mais cela ne semble pas fonctionner.
Quelle est mon erreur ?

Merci

Cdlt

Code:
Sub Macro1()

Dim od As Object 'déclare la variable od (Onglet de Destination)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim ws As Worksheet 'declare la variable ws
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim ac As String 'déclare la variable ac (AC)
Dim ru As String 'déclare la variable ru (RU)
Dim li As Byte 'déclare la variable li (LIgne)
Dim col As Byte 'déclare la variable col (COLonne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

Set od = Sheets("Sheet1") 'définit l'onglet de destination od

        For Each cel In od.Range("B3:E9") 'boucle sur toutes les cellules cel de la plage B3:E9
        ac = Cells(cel.Row, 2).Value 'définit la variable ac (valeur de la cellule dans la même ligne que cel, dans la colonne 2 = B)
        ru = Cells(3, cel.Column) 'définit la variable ru (valeur de la ligne 3, dans la même colonne que cel)
        'définit la recherche r (recherche dans la plage H4:H30 la valeur de ac en entier)
        
Set os = Sheets("Sheet2") 'définit l'onglet source os

        Set r = os.Range("H3:H25").Find(ac, , xlValues, xlWhole)
        'si au moins une occurrence est trouvée, récupère son numéro de ligne dans la variable li, sinon message et sort de la procédure
        If Not r Is Nothing Then li = r.Row Else MsgBox "AC CANT BE FOUND": Exit Sub
        'redéfinit la recherche r (recherche dans la plage I3:O3 la valeur ru en entier)
        Set r = os.Range("I3:O3").Find(ru, , xlValues, xlWhole)
        'si a moins une occurrence est trouvée, récupère son numéro de colonne dans la variable col, sinon message et sort de la procédure
        If Not r Is Nothing Then col = r.Column Else MsgBox "RU CANT BE FOUND": Exit Sub
        'envoie dans la cellule cel la valeur de la cellue en ligne li, colonne col
        cel.Value = Cells(li, col).Value
        
Next cel 'prochaine cellule de la boucle

Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran

End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Extraction de donnees plusieurs fichiers xl / Macro / VBA

Bonjour Repokovski, bonjour le forum,

Je me doutais bien que ce fil allait s'éterniser et je t'avais d'ailleurs donné les raisons dès ma première intervention... Tu veux toujours pas faire l'effort de fournir des données claires et précises je n'interviendrais plus dans ce fil...
Code:
Sub Macro1()
Dim od As Object 'déclare la variable od (Onglet de Destination)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim ws As Worksheet 'declare la variable ws
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim ac As String 'déclare la variable ac (AC)
Dim ru As String 'déclare la variable ru (RU)
Dim li As Byte 'déclare la variable li (LIgne)
Dim col As Byte 'déclare la variable col (COLonne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set od = Sheets("Sheet1") 'définit l'onglet de destination od
For Each cel In od.Range("B3:E9") 'boucle sur toutes les cellules cel de la plage B3:E9
    ac = od.Cells(cel.Row, 2).Value 'définit la variable ac (valeur de la cellule dans la même ligne que cel, dans la colonne 2 = B)
    ru = od.Cells(3, cel.Column) 'définit la variable ru (valeur de la ligne 3, dans la même colonne que cel)
    'définit la recherche r (recherche dans la plage H4:H30 la valeur de ac en entier)
    Set os = Sheets("Sheet2") 'définit l'onglet source os
    Set r = os.Range("H3:H25").Find(ac, , xlValues, xlWhole)
    'si au moins une occurrence est trouvée, récupère son numéro de ligne dans la variable li, sinon message et sort de la procédure
    If Not r Is Nothing Then li = r.Row Else MsgBox "AC CANT BE FOUND": Exit Sub
    'redéfinit la recherche r (recherche dans la plage I3:O3 la valeur ru en entier)
    Set r = os.Range("I3:O3").Find(ru, , xlValues, xlWhole)
    'si a moins une occurrence est trouvée, récupère son numéro de colonne dans la variable col, sinon message et sort de la procédure
    If Not r Is Nothing Then col = r.Column Else MsgBox "RU CANT BE FOUND": Exit Sub
    'envoie dans la cellule cel la valeur de la cellue en ligne li, colonne col
    cel.Value = os.Cells(li, col).Value
Next cel 'prochaine cellule de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib