Добрый день. есть задача.
1) Из Excel файла Spisok с помощью цикла осуществляем перебор ячеек диапазона. Диапазон ("B2:B4).
2) Ячейку А2 из файла Spisok копируем и вставляем в файл по наименованию 1 в ячейку A2.
3) Ячейку А3 из файла Spisok копируем и вставляем в файл по наименованию 2 в ячейку А2.
4) Ячейку А4 из файла Spisok копируем и вставляем в файл по наименованию 3 в ячейку А2.
Все это делается с использованием циклов.
Проблема в одновременном переборе циклом диапазона ячеек в файле Spisok для копирования и переборе Excel-файлов 1, 2, 3 для вставки.

Диапазон на самом деле содержит почти 1600 строк. Но его сократил для понимания задачи.

Помогите пожалуйста решить задачу.

Файлы примеров также прикреплены. Есть код (ниже), но не работает.



Sub KopirovanieIVstavkaVRaznyeWorkbook()

Dim MyRange As Range
Dim MyCell As Range
Dim MyFiles As String

Set MyRange = Application.Workbooks(Spisok.xlsm).Worksheets("Sheet1").Range("B2:B4")
       
       For Each MyCell In MyRange
       If MyCell > 0 Then
           MyFiles = Dir("C:\Users\User\Desktop\Papka\*.xlsx")
           Do While MyFiles <> “”
   
       Workbooks.Open "C:\Users\User\Desktop\Papka\" & MyFiles
       ActiveWorkbook.Worksheets(1).Range("A2") = MyCell
       ActiveWorkbook.Close SaveChanges:=True
       MyFiles = Dir
   
       Exit Do
       Loop
       
       Else
       MyCell.Offset(0, 1).Value = "Pusto"
       
   End If
   Next MyCell

End Sub