searching for matches between two sheets and copying specific values from specific column - excel

Question

i have 2 sheets , in sheet1 i have a column with article names(im geeting my names from sheet1) , in sheet 2 i have a column like that two "Nom de l'entité" (doing a search by header in sheet 2), if i find a match in sheet 2 , i look for a column called "longueur" and copy the value and put it in the offset(0,1) of the article name in sheet 1 . Im a beginner but this is what i did so far.I need to loop through all the article names hoping to fin them all in sheet 2 . Here's a link of photo to see what im trying to do exactly : https://postimg.cc/pmLY9dXc
Sub longueur()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Lecture") '<== Sheet that has raw data
Dim wss As Worksheet: Set wss = ThisWorkbook.Sheets("Feuil1") 'sheet that we re gonna paste longueur into
Dim FoundName As Range, FoundLongueur As Range
Dim c As Range
Set FoundName = ws.Range("A1:DS1").Find("NOM DE L'ENTITÉ") '<== Header name to search for
Set FoundLongueur = ws.Range("A1:DS1").Find("LONGUEUR") '<== Header name to search for in case we already found name match
If Not FoundName Is Nothing And Not FoundLongueur Is Nothing Then
For Each c In Range(wss.Cells.Range("D:D")) 'go back to sheet1 to get the names to search for
If c.value = FoundName Then
FoundLongueur.Offset(0, 1).value
End If
Next c
End If
End Sub

Answer 1

Try
Option Explicit
Sub longueur()
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim rngName As Range, rng As Range, c As Range
Dim colLongueur As Integer, iLastRow As Long
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Feuil1") 'sheet that we re gonna paste longueur into
Set ws2 = wb.Sheets("Lecture") '<== Sheet that has raw data
' find column NOM DE L'ENTITÉ on sheet 2
Set rng = ws2.Range("A1:DS1").Find("NOM DE L'ENTITÉ")
If rng Is Nothing Then
MsgBox "Could not find 'NOM DE L'ENTITÉ' on " & ws2.Name, vbCritical
Exit Sub
End If
' expand to end of column
Set rngName = ws2.Range(rng, ws2.Cells(Rows.Count, rng.Column).End(xlUp))
' find column LONGUEUR on sheet 2
Set rng = ws2.Range("A1:DS1").Find("LONGUEUR")
If rng Is Nothing Then
MsgBox "Could not find 'LONGUEUR' on " & ws2.Name, vbCritical
Exit Sub
End If
colLongueur = rng.Column
' scan sheet 1 col D
iLastRow = ws1.Cells(Rows.Count, "D").End(xlUp).Row
For Each c In ws1.Range("D1:D" & iLastRow)
' find name on sheet 2
Set rng = rngName.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
c.Offset(0, 1).Value = "No Match"
Else
' copy value from column LONGUEUR
c.Offset(0, 1).Value = ws2.Cells(rng.Row, colLongueur)
End If
Next
MsgBox "Ended"
End Sub