dx = Sh.Range("B3:F" & LastRow)

ReDim Detal(i_n)
For i = 3 To i_n
    Detal(i) = Cells(i, 2)
Next i

Sub PereborFailov() 'коллекция в словаре
     Dim a, i&, t$, Dic As Object
     Dim el, col
      
     a = Range("C3", Cells(Rows.Count, "A").End(xlUp)).Value
     Set Dic = CreateObject("Scripting.Dictionary")
     With Dic
         .CompareMode = 1
         For i = 1 To UBound(a)
             t = a(i, 1)
             If Not .exists(t) Then .Add t, New Collection
             .Item(t).Add a(i, 2) & "|" & a(i, 3) & "|" & i
         Next
     End With
      
     For Each el In Dic.keys
         Debug.Print "Открываем файл " & el
         For Each col In Dic.Item(el)
             Debug.Print "Ищем данные " & col
         Next
         Debug.Print "Закрываем файл " & el
     Next

End Sub

Option Explicit

Sub tt()
      Dim a(), i&, d1 As Object, d2 As Object, d3 As Object, t$, k, kol As Object, el, x&

      Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
      Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
      Set d3 = CreateObject("scripting.dictionary"): d3.comparemode = 1    'норма расхода

      '1. набираем словарь номеров с именами листов по данным из "Данные"   
      a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value
      For i = 2 To UBound(a)
          t = Trim(a(i, 1))
          If a(i, 5) > 0 Then d3.Item(t) = a(i, 5)    'норма расхода
          Select Case Trim(a(i, 3))
          Case "Сборка": d1.Item(t) = "Сборка"
          Case "Покупные": d1.Item(t) = "Покупные"
          Case "Кооперация": d1.Item(t) = "Покупные"
          Case "Крепеж": d1.Item(t) = "Крепёж"
          Case Else: d1.Item(t) = "Механический"
          End Select
      Next

      '2. "Итог" берём в массив, проходим циклом, проверяем номер по словарю - получаем имя листа,
      'который берём в другой словарь, где каждому имени листа собираем коллекцию номеров строк, которые в него будем копировать.   

      a = Sheets("Итог").[a2].CurrentRegion.Columns(1).Resize(, 4).Value
      For i = 2 To UBound(a)
          t = Trim(a(i, 2))
          If d1.exists(t) Then
              If Not d2.exists(d1.Item(t)) Then d2.Add d1.Item(t), New Collection
              d2.Item(d1.Item(t)).Add i
          End If
      Next

      '3. цикл уже по словарю имён листов - берём ключ, создаём массив нужного размера (всё уже известно),
      'перекладываем в него данные из исходного массива, выгружаем на лист.   

      For Each k In d2.keys
          Set kol = d2.Item(k)
          ReDim b(1 To kol.Count, 1 To 4) As String
          i = 0
          For Each el In kol
              i = i + 1
              For x = 1 To 4: b(i, x) = a(el, x): Next
          Next
          With Sheets(k)
              .UsedRange.Offset(2).Clear
              .[a3].Resize(UBound(B), 4) = b
          End With
      Next
End Sub