如何解决试图在Excel中获取此VBA以打开特定文件夹以选择要合并的excel文件,我似乎像往常一样绕圈转
试图在Excel中获取此VBA以打开一个特定的文件夹以选择要合并的excel文件,我似乎像往常一样绕着圈转。....
Sub mergeFiles()
'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
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
End Sub
任何有关如何修改代码以使用文件夹的特定路径的想法都会受到赞赏。
在这里希望
解决方法
请尝试下一个代码:
Sub mergeFilesBis()
'Define variables:
Dim i As Integer,tempFileDialog As FileDialog
Dim mainWorkbook,sourceWorkbook As Workbook,tempWorkSheet As Worksheet
Dim initialFolder As String
initialFolder = "C:\"
Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
'Allow the user to select multiple workbooks
With tempFileDialog
.AllowMultiSelect = True
.InitialFileName = initialFolder
If Not .Show = -1 Then Exit Sub
End With
'Loop through all selected workbooks
For i = 1 To tempFileDialog.SelectedItems.count
Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
'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
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。