Работа с несколькими файлами Excel

Question

У меня есть десять файлов Excel с именами A1, A2, A3, A4, A5, A6, A7, A8, A9 и A10 (все в формате .xlsx). Мое требование состоит в том, чтобы читать каждый Excel отдельно, добавлять некоторые формулы и на основе некоторых критериев фильтровать данные и копировать данные пятого столбца, исключая заголовок (первая строка) в другой Excel.

Я сделал что-то вроде этого, но это только для одного листа Excel. Я не знаю, как изменить его для нескольких файлов Excel.

'Start

DataTable.AddSheet "Sheet1" 
DataTable.ImportSheet "A:\Trail 1\Data.xlsx","Sheet1","Sheet1" 
RowCount= DataTable.GetSheet("Sheet1").GetRowCount 

Set objexcel = CreateObject("excel.application") 
Set objWorkbook = objExcel.WorkBooks.Open ("A:\Trail 1\Data.xlsx") 
Set objSheet = objWorkbook.Worksheets(1) 

objexcel.Visible=false 

objexcel.Rows(1).Insert 
objexcel.Columns(2).Insert 
objexcel.Columns(2).Insert 

objSheet.cells(1,1).value="Minutes Interval" 
objSheet.cells(1,2).value="Hour Interval" 
objSheet.cells(1,3).value="Hourly Filter" 
objSheet.cells(1,4).value="HH:MM:SS" 
objSheet.cells(1,5).value="Weight(g)" 

For i = 2 To RowCount+2 Step 1 

objSheet.cells(i,2).value="=A"&i&"/60" 
objSheet.cells(i,3).value="=INT(B"&i&")=B"&i 

Next 

ObjSheet.cells(2,3).autofilter 3,"True" 
Set objRange = objSheet.Range("A1") 
objWorkbook.Worksheets(1).UsedRange.Copy '--- to copy entire sheet data to an intermediate excel 

Set objWorkbookn= objExcel.Workbooks.Open ("A:\Trail 1\In termediateExcel.xlsx") 
Set objSheetn = objWorkbookn.Worksheets(1) 
objWorkbookn.Worksheets(1).Range("A1").PasteSpecial Paste =xlValues '-- pasted here on intermediate excel 
Set objWorkbook2= objExcel.Workbooks.Open ("A:\Trail 1\Result.xlsx") '--- open result excel file 

objSheetn.Activate '-activate the intermediate sheet and get row count 
rc=objWorkbookn.Worksheets("Sheet1").UsedRange.rows.count 
Set src = objWorkbookn.Worksheets(1) 
Set dest = objWorkbook2.Worksheets(1) 
Const sourceColStart = 5 
Const destColStart = 5 
Const destRowStart = 2 'current row 
Const destRowStart = 2 'current row 
Dim currentRow 
currentRow = destRowStart 


For i = 0 To rowcount 
    dest.Cells(currentRow,destColStart).Value = src.Cells(currentRow, sourceColStart) 
    currentRow = currentRow + 1 
Next 

objWorkbook.save 
objWorkbook.close 
objWorkbook2.save 
objWorkbook2.close 
objWorkbookn.save 
objWorkbookn.close 

' End

Answer 1

Я использовал что-то вроде следующего перебрать файлы самостоятельно. Еще одним вариантом является переключение по каталогу. Есть несколько сообщений, которые уже находятся на SO, которые вы можете искать.

Dim filesToOpen 

filesToOpen = Application.GetOpenFilename(_ 
    FileFilter:="Excel 97-2003 Files (*.xls*), *.xls*", _ 
    Title:="Excel files to Open", _ 
    MultiSelect:=True) 

For i = LBound(FilesToOpen) To UBound(FilesToOpen) 

objWorkbookn = Workbooks.Open(filesToOpen(i)) 

'do stuff 

Next i