Comparer 2 feuilles excel et transferer des donnees

jammy17 · 11 Décembre 2013

Bonsoir les Xl dnautes !!

me voilà de reout vers vous pour un nouveau problème.
Sur le fichier ci joint, ou :
-sur la feuille 1 , j'ai les infos suivante "prénoms" , "nmr de poste" , "identifiant"
-sur la feuille 2 , je retrouve que la liste des identifiants dans la colonne B.

je recherche une macro qui me dise, si l'identifiant de la feuille 1 dans la colonne D = identifiant colonne B de la feuille 2 alors inscrit moi dans la colonne C le "nmr" poste correspndant se trouvant sur la feuille 1.

voilà, j'éspère avoir etait assez clai, et si quelqu'un a une idée, je suis preneur, car j'ai developper un truc mais c'est une usine à gaz ! pas assez doué à priori.

merci d'avance

Cordialement

jammy17 · 11 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

personne n'a d'idées ?? , je sèche totalement malgrè une recherche sur la web.

mapomme · 11 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

Bonjour jammy17,

Un essai dans le fichier joint avec la formule en C2 sur Feuil2 et à tirer vers le bas:

Code:

=SIERREUR(INDEX(Feuil1!$C$3:$C$8;EQUIV(Feuil2!B2;Feuil1!$D$3:$D$8;0));"")

jammy17 · 11 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

merci beaucoup Mapomme,

cela repond a ma question, mais je souhaiterai effectivement effectuer la meme chose avec une macro VBA
je ne sais pas si c'est possible

merci encore pour ta reponse
bonne soirée

Toine45 · 12 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

Bonjour
Voici une macro que j'utilise pour un cas similaire (à adapter selon tes besoins)
example :

Comparer la feuille 3 du classeur 1 avec la feuille 4 du classeur 2 et, si une référence de la colonne

A de la feuille 3 est trouvée, dans la colonne B de la feuille 4 : copier les données de la cellule F de la feuille

4 du classeur 2 (se trouvant sur la même ligne que la référence cherchée), dans la cellule C de la feuille 3 du

classeur 1 (en face de cette même référence).

Si la référence n’est pas trouvée dans la feuille 4, ne rien copier.

Code:

Sub A_inventaire_9_Base() '(Fonctionne)

 '(Obligation de définir tous les chemins en modifiant la macro)

 

'-compare la cellule "A2" de la colonne "A" feuille "AA" classeur "Classeur1.xls" avec toutes les cellules de la 

colonne "B" de la feuille "Toto" du classeur "Classeur2" (les noms peuvent changer)

'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille AA du 

classeur "Classeur1.xls"

'par le contenu de la cellule de la colonne "F" de la feuille "Toto" du classeur "Classeur2.xls" dont la valeur est 

la même.

'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"

 'Travail sur 2 feuilles dans 2 classeurs différents)(les noms des feuilles et des classeurs peuvent changer)

'Définition =======================

Dim Cel As Range, Cel_A As Range

Dim F_A As Worksheet, F_B As Worksheet

'Chemins ==============================

Set F_A = Workbooks("Classeur1.xls").Sheets("AA")

Set F_B = Workbooks("Classeur2.xls").Sheets("Toto")

 'ou

'Set F_A = Workbooks("Classeur1.xls").Sheets(1)

'Set F_B = Workbooks("Classeur2.xls").Sheets(3)

'Traitement =======================

For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp)) 'Pour chaque cellule de A

'Cel = cellules de références de feuille 3

 

 If Not (IsEmpty(Cel)) Then 'si Cel n'est pas vide

 Set Cel_A = F_B.Columns(2).Find(Cel) 'Columns(2)= colonne B

 'fixer Cel_a en tant cellule trouvée identique à Cel 'CelA = cellules de références de feuille 4

 

 If Not (Cel_A Is Nothing) Then 'si Cel_A existe

 

'Copie =======================

                'Différentes options  à activer ou désactiver selon les besoins (ou à modifier)

 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")

 'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4

 'copier B et C de Cel sur C et D de Cel_A

 

 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")

 'copier B et C de Cel sur C et D de Cel_A

 

 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "c")

 'Copie les cellules B de la feuille 3 en D de la feuille 4

 'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "c")

 'Copie les cellules B de la feuille 4 en C de la feuille 3

 

 'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")

 'Copie les cellules C de la feuille 4 en E de la feuille 3

F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")

'Copie les cellules F de la feuille 3 en C de la feuille 1

'(F=4 : Colonne de référence + différence pour colonne à copier)

 'F_B.Range(Cel_A.Offset(0, 9), Cel_A.Offset(0, 6)).Copy F_A.Cells(Cel.Row, "C")

 'Copie les cellules H, I, J, K de la feuille 4 en C, D, E, F de la feuille 3

 End If

 End If

Next Cel 'Cel suivante

End Sub

En faisant quelques modifs, ça devrais marcher
Bonne soirée

Toine45 · 12 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

RE-Bonsoir
Ci-dessous macro similaire pour travail sur 2 feuilles dans le même classeur
(à adapter à tes besoins)

Code:

Sub comparaison_copie()

'Travail sur 2 feuilles dans le même classeur)

'Copie de la feuille 4 sur la feuille 3

'Définition =======================

Dim Cel As Range, Cel_A As Range

Dim F_A As Worksheet, F_B As Worksheet

     'Set F_A = Worksheets(1) '1 ère feuille
     'Set F_B = Worksheets(2) '2 ème feuille

Set F_A = Worksheets(3) '3 ème feuille

Set F_B = Worksheets(4) '4 ème feuille

'Comparaison =======================

For Each Cel In F_A.Range(F_A.[A1], F_A.Range("B" & Rows.Count).End(xlUp))

'Pour chaque cellule de A 'Cel = cellules de références de feuille 3

 If Not (IsEmpty(Cel)) Then 'Si Cel n'est pas vide donc :

 

 Set Cel_A = F_B.Columns(2).Find(Cel) 'Columns(2)= colonne B

 'fixer Cel_a en tant cellule trouvée identique à Cel

 'CelA = cellules de références de feuille 4

 If Not (Cel_A Is Nothing) Then 'si Cel_A existe :

 

'Copie des données ====================
'Différentes options (à activer ou désactiver selon les besoins) ou à modifier

 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")

 'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4

 'copier B et C de Cel sur C et D de Cel_A

 

 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")

 'copier B et C de Cel sur C et D de Cel_A

 

'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "c") 

'Copie les cellules B de la feuille 3 en D de la feuille 4

'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "c") 

'Copie les cellules B de la feuille 4 en C de la feuille 3

'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")

'Copie les cellules C de la feuille 4 en E de la feuille 3

‘Ligne en service (les autres étant désactivées selon option choisie)

F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C") 

'Copie les cellules F de la feuille 4 en C de la feuille 3 (J=9 : Colonne de féférence + 

différence pour colonne à copier)

'F_B.Range(Cel_A.Offset(0, 9), Cel_A.Offset(0, 6)).Copy F_A.Cells(Cel.Row, "C")

'Copie les cellules H, I, J, K de la feuille 4 en C, D, E, F de la feuille 3

 

 End If

 End If

Next Cel 'Boucle pour passage à la cellule suivante

End Sub

Cordialement

mapomme · 12 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

Bonjour jammy17, à tous,

jammy17 à dit:
(...) cela repond a ma question, mais je souhaiterai effectivement effectuer la meme chose avec une macro VBA (...)

Une version en vba. La mise à jour se fait quand on active Feuil2.
Le code est dans le module de code de la feuille "Feuil2":

VB:

Private Sub Worksheet_Activate()
Dim xrg As Range
  Application.ScreenUpdating = False
  With Sheets("Feuil1")
    'xrg = zone des prénoms de Feuil1
    Set xrg = .Range("b" & Rows.Count).End(xlUp)
    Set xrg = .Range(.Range("b3"), xrg)
    'définition du nom "ZoneNumFeuil1" de la colonne des numéros sur Feuil1
    ActiveWorkbook.Names.Add Name:="ZoneNumFeuil1", RefersToR1C1:=xrg.Offset(, 1)
    'définition du nom "ZoneIdentFeuil1" de la colonne des Ident sur Feuil1
    ActiveWorkbook.Names.Add Name:="ZoneIdentFeuil1", RefersToR1C1:=xrg.Offset(, 2)
  End With
  
  With Sheets("Feuil2")
    'xrg = zone des Ident de Feuil2
    Set xrg = .Range("b" & Rows.Count).End(xlUp)
    Set xrg = .Range(.Range("b2"), xrg)
    'définition du nom "ZoneIdentFeuil2" de la colonne des Ident sur Feuil2
    ActiveWorkbook.Names.Add Name:="ZoneIdentFeuil2", RefersToR1C1:=xrg
    'effacement des données de la cellule C2 à la fin de la colonne C
    .Range("b2:b" & Rows.Count).Offset(, 1).ClearContents
    'dans colonne C, on met la formule de recherche =>
    '   =SIERREUR(INDEX(ZoneNumFeuil1;EQUIV(B2;ZoneIdentFeuil1;0));"")
    xrg.Offset(, 1).FormulaR1C1 = _
        "=IFERROR(INDEX(ZoneNumFeuil1,MATCH(RC[-1],ZoneIdentFeuil1,0)),"""")"
    'si on VEUT, on transforme les cellules en valeurs
    xrg.Offset(, 1) = xrg.Offset(, 1).Value
  End With
  Application.ScreenUpdating = True
End Sub

mapomme · 12 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

Bonjour jammy17, à tous,

Une autre version (peut-être plus rapide si beaucoup de données - à vérifier). Une référence à Microsoft Scripting Runtime est nécessaire. Elle est normalement automatiquement activée quand on ouvre le classeur (voir le code dans Private Sub Workbook_Open() )

La mise à jour des recherches se fait quand on active Feuil2.
Le code est dans le module de code de la feuille "Feuil2":

VB:

Private Sub Worksheet_Activate()
Dim xrg As Range, dico As New Dictionary, tablo, i&, i1&, i2&, Result
  Application.ScreenUpdating = False
  With Sheets("Feuil1")
    'lecture du tableau (Numéro,Ident) de la feuille Feuil1
    Set xrg = .Range("b" & Rows.Count).End(xlUp)
    Set xrg = .Range(.Range("b3"), xrg).Offset(, 1).Resize(, 2)
    tablo = xrg.Value
    'remplissage du dico
    i1 = LBound(tablo): i2 = UBound(tablo)
    For i = i1 To i2
      dico(tablo(i, 2)) = tablo(i, 1)
    Next i
  End With
      
  With Sheets("Feuil2")
    'lecture du tableau (Ident) de la feuille Feuil2
    Set xrg = .Range("b" & Rows.Count).End(xlUp)
    Set xrg = .Range(.Range("b2"), xrg)
    Result = xrg.Value
    'transformation des Ident de Feuil2 en Numéro de Feuil1
    i1 = LBound(Result): i2 = UBound(Result)
    For i = i1 To i2
      If dico.Exists(Result(i, 1)) Then Result(i, 1) = dico(Result(i, 1)) Else Result(i, 1) = ""
    Next i
    'effacement des données de la cellule C2 à la fin de la colonne C
    .Range("b2:b" & Rows.Count).Offset(, 1).ClearContents
    'écriture du résultat
    xrg.Offset(, 1) = Result
  End With
  Application.ScreenUpdating = True
End Sub

jammy17 · 12 Décembre 2013

Re : Comparer 2 feuilles excel et transferer des donnees

merci beaucoup a tous cela repond parfaitement à ma question !

beau travail les gars

merci et à plus !

Effectuez une recherche sur Excel Downloads...

Comparer 2 feuilles excel et transferer des donnees

jammy17

XLDnaute Occasionnel

Pièces jointes

jammy17

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Pièces jointes

jammy17

XLDnaute Occasionnel

Toine45

XLDnaute Junior

Toine45

XLDnaute Junior

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

jammy17

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée