Rechercher un nom dans plusieurs listes

Bonjour à toutes et tous,
je souhaite faire une macro qui cherche des noms dans différentes listes, et s'il le trouve dans une des listes, il enregistre le titre de la liste.

Pour l'exemple, on peut considérer des listes de villes par pays :

Colonne A    Colonne B    Etc.
France       Espagne
Paris        Madrid
Lyon         Barcelone
Marseille    Valence

Puis j'ai mon tableau de base avec dans la colonne A une liste de ville, et je voudrai mettre dans la colonne B le pays correspondant.

Pour ça je pense utiliser l'application countif, mais quand j'ai pas d'erreur de syntaxe ou de bug, ça ne me met rien du tout dans ma colonne B

Le bout de programme correspondant

Dim NbLigne As Integer
Dim NumLigne As Integer
Dim NbPays As Integer
Dim Pays As String
Dim NumPays As Integer

NbLigne = ThisWorkbook.Sheets("FichierTravail").Cells(Rows.Count, 1).End(xlUp).Row
NbPays = ThisWorkbook.Sheets("ListeVillePays").Cells(1, Columns.Count).End(xlToLeft).Column

For NumLigne = 2 To NbLigne 
    For NumPays = 1 To NbPays
        Ville = Worksheets("FichierTravail").Cells(NumLigne, 1).Value
        If (Application.CountIf(Worksheets("ListeVillePays").Range(Cells(2, NumPays), Cells(50, NumPays)), Ville) > 0) Then Pays = Worksheets("ListeVillePays").Cells(1, Chr(NumPays+65)).Value
    Next
    Worksheets("FichierTravail").Cells(NumLigne, 2).Value = Pays
Next

Est-ce que vous voyez un truc qui cloche?

En pièce jointe le fichier test

Merci d'avance pour votre aide!!!
Gaël

bonjour,

une proposition

Sub Test_macro()
    Dim NbLigne As long
    Dim NumLigne As long
    Dim pays as range

    NbLigne = ThisWorkbook.Sheets("FichierTravail").Cells(Rows.Count, 1).End(xlUp).Row
    NbPays = ThisWorkbook.Sheets("ListeVillePays").Cells(1, Columns.Count).End(xlToLeft).Column

    For NumLigne = 2 To NbLigne
        ville = Worksheets("FichierTravail").Cells(NumLigne, 1).Value
        Set pays = Worksheets("listevillepays").UsedRange.Find(ville, lookat:=xlWhole)
        If Not pays Is Nothing Then
            Worksheets("FichierTravail").Cells(NumLigne, 2).Value = Worksheets("listevillepays").Cells(1, pays.Column)
        End If
    Next
End Sub

Bonjour,

Au niveau du code, ça semble à première vue relativement correct. Essayez de changer comme ceci pour voir :

Dim NbLigne As Integer
Dim NumLigne As Integer
Dim NbPays As Integer
Dim Pays As String
Dim NumPays As Integer

NbLigne = ThisWorkbook.Sheets("FichierTravail").Cells(Rows.Count, 1).End(xlUp).Row
NbPays = ThisWorkbook.Sheets("ListeVillePays").Cells(1, Columns.Count).End(xlToLeft).Column

For NumLigne = 2 To NbLigne 
    For NumPays = 1 To NbPays
        Ville = Worksheets("FichierTravail").Cells(NumLigne, 1).Value
        If WorksheetFunction.CountIf(Worksheets("ListeVillePays").Range(Cells(2, NumPays), Cells(50, NumPays)), Ville) > 0 Then Pays = Worksheets("ListeVillePays").Cells(1, NumPays).Value
    Next
    Worksheets("FichierTravail").Cells(NumLigne, 2).Value = Pays
Next

Changement : WorksheetFunction.countif et NumPays au lieu de Chr(NumPays+65).

Chr(NumPays+65), c'est pas l'idéal et ça pourrait marcher ainsi : Range(Chr(NumPays+65) & 1).

Cordialement,

Bonjour 3GB, malheureusement, j'ai les mêmes erreurs que sur mon code à moi
Par contre...

h2so4 -> ça marche parfaitement!!! Il ne me reste plus qu'à transposer à mon problème à moi qui était un poil plus compliqué, mais je vous dirais si ça correspond à ce dont j'ai besoin.

Merci beaucoup pour votre aide, et pour votre réactivité! (je reviendrai!! )

Transposition OK, c'est top!!!

Rendez-vous à la prochaine complication!!!!

Merci encore :)