Sub tt()
      Dim a(), b(), c(), i&, t&

      With CreateObject("Scripting.Dictionary"): .comparemode = 1
          a = [Лист2!A1].CurrentRegion.Value
          For i = 2 To UBound(a): .Item(a(i, 1)) = i: Next
          b = [Лист1!A1].CurrentRegion.Columns(1).Value
          c = [Лист1!A1].CurrentRegion.Columns(2).Resize(, 3).Value
          For i = 2 To UBound(b)
              If .exists(b(i, 1)) Then
                  t = .Item(b(i, 1))
                  c(i, 1) = a(t, 2)
                  c(i, 2) = a(t, 3)
                  c(i, 3) = a(t, 4)
              Else
                  c(i, 1) = "нет данных": c(i, 2) = "нет данных": c(i, 3) = "нет данных"
              End If
          Next
          [Лист1!A1].CurrentRegion.Columns(2).Resize(, 3).Value = c
      End With
End Sub

Public Sub RefreshData()
'Created using add-in ActiveTables
Dim strConnection As String
Dim strSQL As String
strConnection = iif(Val(application.Version) < 12,"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';","OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';")
strSQL = "SELECT  Лист2.нг AS нг, Лист2.Цвет AS Цвет, Лист2.Размер AS Размер FROM  [Лист1$] AS Лист1  LEFT JOIN [Лист2$] AS Лист2  ON Лист1.Номер=Лист2.Номер "
With ThisWorkbook.Sheets(1)
     .Range("B:D").Delete
     With .QueryTables.Add(strConnection, .Range("B1"), strSQL)
          .Refresh False
          .Delete
     End With
End With
End Sub