Sub test()
Dim Cel As Range, Tablo1, Tablo2, I As Byte
Tablo1 = Array("B13:B17", "B33:B37", "B53:B57")
Tablo2 = Array("B25", "B45", "B65")
For I = LBound(Tablo1) To UBound(Tablo1)
For Each Cel In Range(Tablo1(I))
If Cel.Value = Range(Tablo2(I)).Value Then
Cel.Offset(0, 1) = Range(Tablo2(I)).Offset(0, 1).Value
Cel.Offset(0, 6) = Range(Tablo2(I)).Offset(0, 6).Value
End If
Next Cel
Next I
End Sub