Getting values off another sheet by references!?

Hello,

please have a quick look at my attachment: I need to fill the columns B-D of the sheet "starting data" with the values matching
the IDs of the sheet "reference". The result should look like shown in sheet "result after code".

You can also find my somewhat working solution inside (press the arrow), but its performance is too bad, it takes several minutes
to run on the actual lists wich contain 20,000 - 30,000 rows each, wich is not acceptable.

Can you guys help me out with a better working solution to my problem?

Does this help you?

Code:

---

Sub fillme()
Dim CELLORI As RangeDim CELLREF As Range
For Each CELLORI In Tabelle2.Range("B2:B999999")
    If CELLORI.Text = "" And CELLORI.Offset(0, -1).Text = "" Then
Exit For
    Else
        For Each CELLREF In Tabelle1.Range("B2:B999999")
            If CELLREF.Offset(0, -1).Text = Empty Then
        Exit For
            End If
            If CELLREF.Text = CELLORI.Text Then
                CELLORI.Value = CELLREF.Offset(0, 2).Text
                CELLORI.Offset(0, 1).Value = CELLREF.Offset(0, 3).Text
                CELLORI.Offset(0, 2).Value = CELLREF.Offset(0, 1).Text & " " & CELLREF.Offset(0, 4).Text
        Exit For
            End If
        Next CELLREF
    End If
Next CELLORI
End Sub

---

Hello Assiebear,

thank you for your answer and sorry for the late reply.
Your code works but unfortunately it is still pretty slow.

I got this code in the meantime wich works really fast:

Code:

---

Sub bydo()Dim n As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("starting data")
    For n = .Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
    .Range(.Cells(n, "B"), .Cells(n, "D")).FormulaArray = "=VLOOKUP(A" & n & ",reference!$B:$F,{3,4,5},FALSE)"
    Next n
    .Range("B2:D" & .Range("A" & Rows.Count).End(3).Row).Value = .Range("B2:D" & .Range("A" & Rows.Count).End(3).Row).Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

---