> Tous les forums > Forum Autres langages
 Récupérer données de 3 fichiers Excel en 1 seul !!
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
audrey57
  Posté le 28/04/2011 @ 16:01 
Aller en bas de la page 
Nouvelle astucienne

Bonjour à tous,

Je viens de débuter mon stage et doit effectuer un travail sur Excel.

J'ai 3 fichiers excel avec un champs commun (un numéro de compte) et souhaite les fusionner en un seul autre fichier récapitulatif. Si c'est plus simple pour vous, je peux avoir un fichier avec 3 feuilles.

Je peux avoir des comptes présents dans 1, 2 ou les 3 fichiers. J'ai récupéré un code pour macro (ci-dessous) mais celui-ci ne traite que dans le cas de 2 fichiers et ne me récupère uniquement les lignes qui ont un numéro de compte identique dans les 2 fichiers.

J'ai besoin moi de récupérer toutes les lignes de mes 3 fichiers et dans le cas de numéro de compte présent dans 2 ou 3 fichiers compléter la seule ligne qui est dans mon fichier résultat. Pourriez vous me compléter ce code s'il vous plait? Je galère...

Merci beaucoup de votre aide.

Un petit schéma si ce n'est pas clair...

Fichier 1

N° info1 info2 info3

1 x x x

2 x x x

3 x x x

8 x x x

Fichier2

N° info4 info5 info6

1 x x x

4 x x x

5 x x x

8 x x x

Fichier3

N° info7 info8 info9

1 x x x

3 x x x

5 x x x

6 x x x

Résultat souhaité:

N° info1 info2 info3 info4 info5 info6 info7 info8 info9

1 x x x x x x x x x

2 x x x - - - - - -

3 x x x - - - x x x

4 - - - x x x - - -

5 - - - x x x x x x

6 - - - - - - x x x

8 x x x x x x - - -

Sub galopin()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, i1, i2, i3, k, kk, z
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
Set ws3 = Worksheets(3)
i1 = ws1.Range("A1").End(4).Row
i2 = ws2.Range("A1").End(4).Row
With ws1
For k = 1 To i1
z = .Range("A" & k)
For kk = 1 To i2
If z = ws2.Range("A" & kk) Then
ws3.Range("A" & i3 + 1) = z
ws3.Range("B" & i3 + 1) = .Range("B" & k)
ws3.Range("C" & i3 + 1) = .Range("C" & k)
ws3.Range("D" & i3 + 1) = .Range("D" & k)
ws3.Range("E" & i3 + 1) = ws2.Range("B" & kk)
ws3.Range("F" & i3 + 1) = ws2.Range("C" & kk)
ws3.Range("G" & i3 + 1) = ws2.Range("D" & kk)
i3 = i3 + 1
End If
Next
Next
End With
End Sub

Publicité
leongka
 Posté le 30/04/2011 à 01:18 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Maître astucien

PellocHoaz
 Posté le 04/05/2011 à 17:03 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Bonjour,

Exemple:

Sub Galopin()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, Resultat As Worksheet
Dim i1 As Long, i2 As Long, i3 As Long, k As Long, kk As Long
Dim Reponse As Boolean, Adresse As String
Dim z As Variant

Application.ScreenUpdating = False

Set Resultat = Worksheets("Resultat")
Set ws1 = Worksheets("Feuil1")
Set ws2 = Worksheets("Feuil2")
Set ws3 = Worksheets("Feuil3")

i1 = ws1.Range("A65536").End(xlUp).Row
i2 = ws2.Range("A65536").End(xlUp).Row
i3 = ws3.Range("A65536").End(xlUp).Row

Resultat.Activate
Range("A1:J1").Value = Array("No", "Info1", "Info2", "Info3", "Info4", "Info5", "Info6", "Info7", "Info8", "Info9")
Range("A2").Select

' Recherche et copie des Numéro qui serviront d'index

' Feuille 1 - Copie intégral
For k = 2 To i1
z = ws1.Range("A" & k).Value
ActiveSheet.Cells(k, 1).Value = z
Next k

' Feuille 2 - Recherche valeur
For k = 2 To i2
z = ws2.Range("A" & k).Value
If (Resultat.Range("A2:A65536").Find(z) Is Nothing) Then
Position = (Resultat.Range("A65536").End(xlUp).Row - 1)
ActiveCell.Offset(Position, 0).Value = z
End If
Next k

' Feuille 3
For k = 2 To i3
z = ws3.Range("A" & k).Value
If (ActiveSheet.Range("A2:A65536").Find(z) Is Nothing) Then
Position = (Resultat.Range("A65536").End(xlUp).Row - 1)
ActiveCell.Offset(Position, 0).Value = z
End If
Next k

Position = Resultat.Range("A65536").End(xlUp).Row
Resultat.Range("A2:A" & Position).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Resultat.Range("A2").Select

' Copie des données

' Feuille 1
For k = 2 To i1
z = ws1.Range("A" & k).Value
If Not (Resultat.Range("A2:A65536").Find(z) Is Nothing) Then
Adresse = Resultat.Range("A2:A65536").Find(z).Address
Resultat.Range(Adresse).Select
ActiveCell.Offset(0, 1).Value = ws1.Range("B" & k).Value
ActiveCell.Offset(0, 2).Value = ws1.Range("C" & k).Value
ActiveCell.Offset(0, 3).Value = ws1.Range("D" & k).Value
End If
Next k

' Feuille 2
For k = 2 To i2
z = ws2.Range("A" & k).Value
If Not (Resultat.Range("A2:A65536").Find(z) Is Nothing) Then
Adresse = Resultat.Range("A2:A65536").Find(z).Address
Resultat.Range(Adresse).Select
ActiveCell.Offset(0, 4).Value = ws2.Range("B" & k).Value
ActiveCell.Offset(0, 5).Value = ws2.Range("C" & k).Value
ActiveCell.Offset(0, 6).Value = ws2.Range("D" & k).Value
End If
Next k

' Feuille 3
For k = 2 To i3
z = ws3.Range("A" & k).Value
If Not (Resultat.Range("A2:A65536").Find(z) Is Nothing) Then
Adresse = Resultat.Range("A2:A65536").Find(z).Address
Resultat.Range(Adresse).Select
ActiveCell.Offset(0, 7).Value = ws2.Range("B" & k).Value
ActiveCell.Offset(0, 8).Value = ws2.Range("C" & k).Value
ActiveCell.Offset(0, 9).Value = ws2.Range("D" & k).Value
End If
Next k

Application.ScreenUpdating = True

End Sub
'

Cdt

PellocHoaz



Modifié par PellocHoaz le 03/06/2011 13:53
FCL31
 Posté le 15/07/2011 à 12:49 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Bonjour

Je sais que c'est peut étre un peu tard mais je vais donner un peu de mon aide

J'ai fait un fichier qui e permet de regrouper plusieurs fichier Excel en 1 (chaqu'un des fichiers a plusieurs feuilles)

Seul imperatif, tout tes fichiers, doivent étre dans un même dossier (car il y a une fonction de recherche de dossier dans mon fichier de regroupement)

Sa fait un moment que je ne me suis pas servis de ce fichier mais normalement il marche pas trop mal (je me suis fait un fichier plus complexe).

Fichier a télécharger ICI

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Sujets relatifs
Récupérer données de 3 fichiers Excel en 1 seul !!
Récupérer données de 3 fichiers Excel en 1 seul
[C]Recuperer données dans un string
Macro excel : regrouper plusieurs fichiers
extraire des données avec excel et VB
mysql base de données de récupération dans wampserver2
Base de données et VS 2015
VBA excel transformer date à chiffre
VBA récupérer couleur sur image collée
VBA Excel francisé
Plus de sujets relatifs à Récupérer données de 3 fichiers Excel en 1 seul !!
 > Tous les forums > Forum Autres langages