将多个工作博合并到当前工作博里面。Sub MergeSelectedFilesIntoCurrentWorkbook() Dim ws As Worksheet Dim wb As Workbook Dim targetWorkbook As Workbook Dim fileNames As Variant Dim i As Integer Dim sheet As Worksheet Dim csvWs As Worksheet Dim ext As String 选择文件修正后的筛选器格式 fileNames Application.GetOpenFilename( _ FileFilter:Excel Files (*.xls*),*.xls*,CSV Files (*.csv),*.csv, _ Title:选择要合并的Excel/CSV文件, _ MultiSelect:True) 如果没有选择文件则退出 If Not IsArray(fileNames) Then MsgBox 没有选择文件操作取消。 Exit Sub End If 禁用屏幕更新以提高速度 Application.ScreenUpdating False On Error GoTo ErrorHandler 【关键修改】设置为当前正在操作的工作簿而不是宏所在的工作簿 Set targetWorkbook ActiveWorkbook 循环遍历选择的文件 For i LBound(fileNames) To UBound(fileNames) 统一转为小写取后5位包含点号兼容 .xlsx, .xlsm, .csv ext LCase(Right(fileNames(i), 5)) If ext .xlsx Or ext .xlsm Or ext .xlsb Or ext .xls Then 处理Excel文件 Set wb Workbooks.Open(fileNames(i)) For Each sheet In wb.Sheets sheet.Copy After:targetWorkbook.Sheets(targetWorkbook.Sheets.Count) Next sheet wb.Close False ElseIf ext .csv Or LCase(Right(fileNames(i), 3)) csv Then 处理CSV文件兼容后3位判断 Set wb Workbooks.Open(fileNames(i)) Set csvWs wb.Sheets(1) csvWs.Copy After:targetWorkbook.Sheets(targetWorkbook.Sheets.Count) wb.Close False End If Next i 激活目标工作簿确保你能看到复制进来的表格 targetWorkbook.Activate 重新启用屏幕更新 Application.ScreenUpdating True MsgBox 所有选定的文件已成功合并到当前工作簿中。 Exit Sub ErrorHandler: 出错时确保屏幕刷新恢复并提示错误 Application.ScreenUpdating True MsgBox 合并过程中出现错误 vbCrLf Err.Description End Sub