Teste et copie les données de la Feuil1 vers la Feuil2

nakadon

XLDnaute Occasionnel
Bonjour,

J'ai un classeur, avec Feuil1 et Feuil2.
Le Feuil2 est une basse de données avec toutes les informations dont j'ai besoin.
Est-ce possible d'avoir un bouton associé à une macro qui fait ceci : quand je saisis des noms et des prénoms dans la Feuil1, qu'une macro vérifie en fonction des noms et des prénoms si les personnes existent dans la Feuil2. Si oui, la macro complète pour chaque personne, le reste des informations dont j'ai besoin dans la Feuil1 (civilité, 2ème Nom, adresse, Code, Pays, Ville, continent, activité).
Les colonnes ne sont pas dans le même ordre dans Feuil1 et Feuil2. Par contre, il n'y a pas de doublons dans la Feuil2, mais il peut y avoir deux personnes voir plus avec le même nom. Enfin si la personne n'existe pas dans la Feuil2, colorier toute la ligne en rouge dans la Feuil1.
Les données saisies manuellement dans la Feuil1 sont en bleues, le reste est rempli automatiquement par la macro.
Ci-joint un fichier exemple fictif.

Merci d'avance pour votre aide.
 

Pièces jointes

  • Compare.xls
    48 KB · Affichages: 85
  • Compare.xls
    48 KB · Affichages: 80
  • Compare.xls
    48 KB · Affichages: 83
Dernière édition:

PMO2

XLDnaute Accro
Re : Teste et copie les données de la Feuil1 vers la Feuil2

Bonjour,

Une piste avec le code suivant à copier dans un module standard

Code:
'### Constantes à adapter (noms des feuilles) ###
Const BASE As String = "Feuil2"
Const SAISIE As String = "Feuil1"
'################################################

Sub ComparePMO()
Dim WB As Workbook
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim var1
Dim var2
Dim R2 As Range
Dim C As Range
Dim i&
Dim j&
Dim k&
Dim Col1
Col1 = Array(, 1, 2, 9, 4, 12, 6, 7, 10, 8, 11)
Set WB = ThisWorkbook
Set S1 = WB.Sheets(BASE)
var1 = S1.[a1].CurrentRegion
Set S2 = WB.Sheets(SAISIE)
Set R2 = S2.Range("a2:j" & S2.[b65536].End(xlUp).Row & "")
var2 = R2
For i& = 1 To UBound(var2, 1)
  For j& = 1 To UBound(var1, 1)
    If UCase(var2(i&, 2)) = UCase(var1(j&, 2)) And _
        UCase(var2(i&, 4)) = UCase(var1(j&, 4)) Then
      For k& = 1 To 10
        var2(i&, k&) = var1(j&, Col1(k&))
        If k& = 1 Then
          If var2(i&, k&) = "H" Then
            var2(i&, k&) = "M."
          Else
            var2(i&, k&) = "Mme"
          End If
        End If
      Next k&
      Exit For
    End If
  Next j&
Next i&
R2 = var2
For Each C In R2.Range("a1:a" & UBound(var2, 1) & "")
  If C = "" Then
    C.Resize(1, 10).Interior.Color = vbRed
  End If
Next C
End Sub


Cordialement.

PMO
Patrick Morange
 

nakadon

XLDnaute Occasionnel
Re : Teste et copie les données de la Feuil1 vers la Feuil2

Bonsoir et merci bcp,
ça marche exactement comme je voulais.
J'espère que je n'abuse pas en te demandant deux petites précisions.

- Que dois-je modifier dans la macro si je veux copier des données sur plus de 10 colonnes, sur 15 colonnes p.ex ? J’ai tenté de modifier les lignes suivantes :
Col1 = Array(, 1, 2, 9, 4, 12, 6, 7, 10, 8, 11, 12, 13, 14, 15, 16) et For k& = 1 To 15
ça ne marche pas, erreur d'indice.

- Comment renseigner le nom de la base "Feuil2" si elle ne se trouve pas dans le même classeur que Feuil1?

Encore une fois, Merci infiniment pour ce que tu as déjà fait.
 
Dernière édition:

PMO2

XLDnaute Accro
Re : Teste et copie les données de la Feuil1 vers la Feuil2

Bonjour,

- Que dois-je modifier dans la macro si je veux copier des données sur plus de 10 colonnes, sur 15 colonnes p.ex ? J’ai tenté de modifier les lignes suivantes :
Col1 = Array(, 1, 2, 9, 4, 12, 6, 7, 10, 8, 11, 12, 13, 14, 15, 16) et For k& = 1 To 15
ça ne marche pas, erreur d'indice.

Vérifiez si votre feuille base de données contient des données sur 16 colonnes sinon renseignez les et votre code devrait marcher.
16 est la colonne la plus élevée dans Col1 = Array(, 1, 2, 9, 4, 12, 6, 7, 10, 8, 11, 12, 13, 14, 15, 16)

Est-ce le cas ?

Cordialement.

PMO
Patrick Morange
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou