Astuces Excel
  1. Astuces Excel
  3. Macro Excel VBA: Iterating over values ​​sur une page pour vérifier la correspondance sur une autre page et affecter une valeur
Intereting Posts
excel – nested si conditionnement Excel: extraire des colonnes d'un classur pour append à un autre classur Excel: Ouvrir dans la première cellule vide Copier quelques lignes sur de nouvelles colonnes – Excel Comment puis-je convertir SUM en MAX dans toutes les lignes en excel? Dictionnaire dans un dictionary Comment faire une boucle for uniquement avec des lignes et un nombre fixe de colonnes? Impossible de find l'espace de noms XLSX sur l'utilisation du module xlsx-style Je souhaite supprimer une feuille de calcul lorsque je supprime une ligne dans une autre feuille de calcul (EXCEL 2007) CSV Fin de ligne Macro Excel (sauvegarde dans Sharepoint Library) n'accepte plus l'arrêt complet? Comment changer cette méthode pour renvoyer un groupe de strings Excel VBA: maintien du formatting des nombres avec des numbers et des lettres Existe-t-il un moyen de créer un dossier et des sous-dossiers dans Excel VBA? La formule EPPlus ne fonctionne pas sans appeler Calculer

Macro Excel VBA: Iterating over values ​​sur une page pour vérifier la correspondance sur une autre page et affecter une valeur

Ce que je veux faire: Iterate sur les valeurs sur une page pour vérifier la correspondance sur une autre page et si une correspondance est trouvée, prenez une valeur à partir de la 2ème page de la même ligne mais de la colonne différente.

J'ai essayé depuis un bon moment. Je suis nouveau dans VBA-scripting / Excel et je peux aborder le problème de manière incorrecte, et pourquoi je pose la question ici!

Mon code jusqu'à présent: 

Sub InsertData() ScreenUpdating = False Dim wks As Worksheet Dim subSheet As Worksheet Set subSheet = Sheets("Sheet4") Dim rowRangeSub As Range Dim LastRowSub As Long LastRowSub = subSheet.Cells(subSheet.Rows.Count, "C").End(xlUp).Row Set rowRangeSub = subSheet.Range("C2:C" & LastRowSub) Dim subGroupList As ListObject Dim rowRange As Range Dim colRange As Range Dim LastCol As Long Dim LastRow As Long Dim Found As Range 'START OF SHEET1' Set wks = Sheets("SHEET1") LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row Set rowRange = wks.Range("B2:B" & LastRow) 'Loop through each row in B column (Names)' For Each rrow In rowRange If Not IsEmpty(rrow) Then With Sheets("Sheet4").Range("C2:C" & LastRowSub) Set Found = .Find(What:=rrow, _ After:=.Cells(1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Found Is Nothing Then 'Debug.Print "Found"' wks.Cells(rrow.Row, "K").Value = "Found" Else wks.Cells(rrow.Row, "K").Value = "Not Found" 'Debug.Print "Not Found"' End If End With End If Next rrow 'END OF SHEET1' 'START OF SHEET2' Set wks = Sheets("SHEET2") LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row Set rowRange = wks.Range("B2:B" & LastRow) 'END OF SHEET2' 'START OF SHEET3' Set wks = Sheets("SHEET3") LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row Set rowRange = wks.Range("B2:B" & LastRow) 'END OF SHEET3' ScreenUpdating = True End Sub

La configuration dans le file Excel est en tant que telle: Les trois feuilles, Sheet1, Sheet2, Sheet3 contiennent beaucoup de données dans ses 10 premières colonnes (AJ) et la 11ème colonne (K) est l'endroit où datatables doivent être insérées si elles sont a trouvé. Les données pertinentes, les noms, se trouvent dans la colonne B où B: 1 est simplement «Nom» comme titre. Il y a aussi des cellules vides dans la colonne à prendre en considération.

La 4ème feuille, Sheet4 contient certaines données dans ses 5 premières colonnes. Les noms qui doivent correspondre peuvent être trouvés dans la colonne C, et si une correspondance est trouvée, il est censé collecter des données à partir des Cellules (Found.Row, "E") où "E" est la colonne E.

Ce problème a beaucoup vécu avec beaucoup de tête puisque .Find () – la fonction semble ne pas fonctionner comme je l'espère, car il trouve parfois les contraires.

Ma principale question est: Comment puis-je affecter la valeur correcte à la ligne? 

 wks.Cells(rrow.Row, "K").Value = rowRangeSub.Cells(Found.Row, "E").Value

J'ai l'printing d'avoir testé au less 10 manières différentes d'atsortingbuer, mais je continue d'get une erreur après une erreur. La plupart du time, c'est une erreur de missmatch.

Toute aide est appréciée!

EDIT depuis la lecture des commentaires: ok, voila: toutes les colonnes sont formatées en tant que text. Colonne A: Numéros personnels: pas pertinent Colonne B: Noms: Le formulaire est: Nom, Prénom. Ceci est utilisé lors de la search d'une correspondance. La colonne C à J n'est pas pertinente avec diverses informations sur une personne. Colonne K: cette cellule de colonnes commence vide. Ceci est à remplir par la macro.

J'ai trois livres différents dans le file Excel qui ont des données qui ressemblent à ce que j'ai expliqué, juste des données différentes dans chaque livre.

Le 4ème livre est en tant que tel: les colonnes A et B ne sont pas pertinentes avec des informations qui ne sont pas du tout nécessaires.

Colonne C: les noms dans la forme Nom, Prénom. C'est ce que devraient être les cellules de la colonne à comparer avec les cellules de la colonne B dans les autres livres.

Colonne D: Indifférent

Colonne E: C'est la partie importante de Sheet4. Pour chaque personne, il existe un "nombre de groupe" qui peut être trouvé dans cette colonne pour chaque ligne.

Ce que je veux faire, c'est comparer chaque cellule dans la colonne B dans Sheet1-3 pour une correspondance dans la colonne C dans Sheet4. Si une correspondance est trouvée (tous ne sont pas affectés à un groupe, les correspondances peuvent ne pas être trouvées), puis prenez les informations de la cellule à partir de Sheet4 sur la ligne, une correspondance a été trouvée et la colonne "E", mettez cette information dans la ligne de Sheet1-3 et la colonne "K".

Exemple de données (existe-t-il un moyen de soumettre des tables?): Sheet1:

COLONNE B

Tablesson, Stylo

Papier, encre

Eraser, écran

COLUMN K est actuellement vide

Sheet4:

COLONNE C

Papier, encre

Eraser, écran

COLONNE E

55

77

FUNCRE LE MACRO, Sheet1 after macro:

COLONNE B

Tablesson, Stylo

Papier, encre

Eraser, écran

COLONNE K

[La première input est vide car aucune correspondance n'a été trouvée]

55

77

Espérons que cela est compréhensible!

    J'ai simplifié le process en utilisant un dictionary Scripting. 

     Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Sub InsertData () Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim lastRow As Long, x As Long Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim dicNames, k As Ssortingng, v As Variant Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Définir dicNames = CreateObject ("scripting.dictionary") Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub 'Créer une list de Noms à comparer et valeurs à mettre à jour Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Avec des feuilles de travail ("Sheet4") Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub lastRow = .Cells (Rows.Count, "A"). End (xlUp) .Row Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Pour x = 2 À lastRow Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub k = .Cellules (x, 3). Valeur 'Nom de la colonne C Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub v = .Cellules (x, 5) .Value 'Valeur de la colonne E Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub 'Ajoutez des paires de valeurs keys au dictionary Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Si non dicNames.Exists (k) Puis dicNames.Add k, v Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Fiches de travail ProcessWorksheet ("Sheet1"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Feuilles de travail ProcessWorksheet ("Sheet2"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Feuilles de travail ProcessWorksheet ("Sheet3"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub End Sub Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Sub ProcessWorksheet (ws As Worksheet, ByRef dicNames) Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim k As Ssortingng, v As Range Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim lastRow As Long, x As Long Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Avec ws Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub lastRow = .Cells (Rows.Count, "A"). End (xlUp) .Row Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Pour x = 2 À lastRow Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub k = .Cells (x, 2) 'Si le nom de la colonne B Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Si dicNames.Exists (k) Ensuite Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub .Cellules (x, 11) = dicNames (k) 'Ensuite Colonne K = Valeur de Sheet4 Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub 
     Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Sub InsertData () Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim lastRow As Long, x As Long Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim dicNames, k As Ssortingng, v As Variant Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Définir dicNames = CreateObject ("scripting.dictionary") Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub 'Créer une list de Noms à comparer et valeurs à mettre à jour Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Avec des feuilles de travail ("Sheet4") Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub lastRow = .Cells (Rows.Count, "A"). End (xlUp) .Row Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Pour x = 2 À lastRow Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub k = .Cellules (x, 3). Valeur 'Nom de la colonne C Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub v = .Cellules (x, 5) .Value 'Valeur de la colonne E Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub 'Ajoutez des paires de valeurs keys au dictionary Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Si non dicNames.Exists (k) Puis dicNames.Add k, v Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Fiches de travail ProcessWorksheet ("Sheet1"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Feuilles de travail ProcessWorksheet ("Sheet2"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Feuilles de travail ProcessWorksheet ("Sheet3"), dicNames Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub End Sub Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Sub ProcessWorksheet (ws As Worksheet, ByRef dicNames) Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim k As Ssortingng, v As Range Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Dim lastRow As Long, x As Long Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Avec ws Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub lastRow = .Cells (Rows.Count, "A"). End (xlUp) .Row Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Pour x = 2 À lastRow Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub k = .Cells (x, 2) 'Si le nom de la colonne B Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub Si dicNames.Exists (k) Ensuite Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub .Cellules (x, 11) = dicNames (k) 'Ensuite Colonne K = Valeur de Sheet4 Sub InsertData() Dim lastRow As Long, x As Long Dim dicNames, k As Ssortingng, v As Variant Set dicNames = CreateObject("scripting.dictionary") 'Create list of Names to compare against and values to update With Worksheets("Sheet4") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 3).Value 'Name from Column C v = .Cells(x, 5).Value 'Value From Column E 'Add Key Value pairs to Dictionary If Not dicNames.Exists(k) Then dicNames.Add k, v Next End With ProcessWorksheet Worksheets("Sheet1"), dicNames ProcessWorksheet Worksheets("Sheet2"), dicNames ProcessWorksheet Worksheets("Sheet3"), dicNames End Sub Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames) Dim k As Ssortingng, v As Range Dim lastRow As Long, x As Long With ws lastRow = .Cells(Rows.Count, "A").End(xlUp).Row For x = 2 To lastRow k = .Cells(x, 2) 'If Name from Column B If dicNames.Exists(k) Then .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4 End If Next End With End Sub