Скопируйте несмежные ячейки из подпапок Excel-файлов и вставьте построчно в мастер-файлы Excel, найденные в родительской папке.

Question

Я получил 4 подпапки, содержащие файлы Excel в формате .xlsm. Мне нужно скопировать данные из одних и тех же несмежных ячеек (A1, B5, C6) из всех файлов Excel в подпапках. Я получил родительскую папку, в которой хранится моя основная рабочая книга. Я хочу, чтобы данные из каждого файла Excel (A1, B5, C6) были вставлены в лист основной рабочей книги1 в табличной форме.

'Loop through the collection

    For Each myItem In collSubFolders

'Loop through Excel workbooks in subfolder

      myFile = Dir(myFolder & myItem & "\*.xlsm*")



     Do While myFile <> “”

'Open workbook

     Set wbk = Workbooks.Open(Filename:=myFolder & myItem & " \ " & myFile)

'Copy data from the opened workbook

      lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

      lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

      ActiveSheet.Range("A1,B5,C6").Copy
'Close opened workbook without saving any changes

     wbk.Close SaveChanges:=False

           erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

      ActiveSheet.Cells(erow, 1).Select

      ActiveSheet.Paste

     ActiveWorkbook.Save

     Application.CutCopyMode = False

       myFile = Dir
     Loop

     Next myItem

       Application.ScreenUpdating = True


    End Sub

Answer 1

Самая большая проблема заключается в том, что вы пытаетесь скопировать ряд несмежных ячеек, что не разрешено в Excel. Также вы используете активную таблицу, к которой вам следует обращаться непосредственно к рабочим книгам и таблицам.
Вы не были очень точны в том, что вы хотели или в названии вашего мастер-файла, поэтому Вот то, что можно запустить, чтобы поместить A1, B5, C6 в основной файл на листе 1 в A1, A2, A3, затем то же самое в столбце B для следующего файла, через отдельный столбец для каждого файла, который вы открываете. Вам нужно будет изменить команду Dir для конкретных нужд.

myfile = Dir(direct, "*.xlsm")  'sets myfile equal to the first file name
Do While myfile <> ""        'loops until there are no more files in the direstory
CLMS = Workbooks("Master_file.xlsx").Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Set wbk = Workbooks.Open(FileName:=fname)

    Workbooks(myfile).Sheets(1).Range("A1").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(1, CLMS)
    Workbooks(myfile).Sheets(1).Range("B5").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(2, CLMS)
    Workbooks(myfile).Sheets(1).Range("C6").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(3, CLMS)
           wbk.Close SaveChanges:=False`
Workbooks("Master_file.xlsx").save

     myfile = Dir            

Loop