我们使用下面的代码来提取所有选定的工作簿。并将它们合并为一张工作簿中的工作表,然后将所有工作表合并为一个列表。
工作正常。
但是,我希望它采用活动文件夹中所有以“ packaginglist.xlsx”(通配符为)结尾的文件。如果没有该对话框可以节省一些时间和潜在的错误。
Sub Konsolider_pakkeliste()
'Merges all files in a folder to a main file.
'Define variables:
Dim numberOfFilesChosen,i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook,sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet
Dim xTCount As Variant
Dim xWs As Worksheet
On Error Resume Next
Workbooks.Add
ChDir "C:\XML_Pakkelister\" & Range("C6")
activeWorkbook.SaveAs FileName:= _
"C:\XML_Pakkelister\" & Range("C6") & "\" & Range("C4") & " Consolidated packaginglist.xlsx" _,FileFormat:=xlOpenXMLWorkbook,CreateBackup:=False
'*******************************************************************************************
Set mainWorkbook = Application.activeWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
'Allow the user to select multiple workbooks
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
'Loop through all selected workbooks
For i = 1 To tempFileDialog.SelectedItems.count
'Open each workbook
Workbooks.Open tempFileDialog.SelectedItems(i)
Set sourceWorkbook = activeWorkbook
'Copy each worksheet to the end of the main workbook
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.count)
Next tempWorkSheet
'Close the source workbook
sourceWorkbook.Close
Next i
'*******************************************************************************************
'UpdateByKutools20151029
'Combine the sheets
LInput:
xTCount = 1
Set xWs = activeWorkbook.Worksheets.Add(Sheets(1))
xWs.Name = "Combined"
Worksheets(2).Range("A17").EntireRow.Copy Destination:=xWs.Range("A17")
For i = 2 To Worksheets.count
Worksheets(i).Range("A17").CurrentRegion.Offset(CInt(xTCount),0).Copy _
Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.count).Row,1)
Next
End Sub