【简单】多个excel表合并,你还在一个个复制吗?只需一秒合并到对应的sheet表中

Sub MergeExcelFilesToSheets()    Dim fldPath As String    Dim fileName As String    Dim srcWB As Workbook    Dim destWB As Workbook    Dim destSheet As Worksheet    Dim sheetName As String    Dim i As Long    ' 设置目标工作簿为当前活动工作簿（也可改为新建工作簿，见注释）    Set destWB = ThisWorkbook    ' 选择文件夹    With Application.FileDialog(msoFileDialogFolderPicker)        .Title = "请选择包含Excel文件的文件夹"        .AllowMultiSelect = False        If .Show <> -1 Then Exit Sub   ' 用户取消        fldPath = .SelectedItems(1) & "\"    End With    ' 关闭屏幕刷新和警告，提速并防止提示    Application.ScreenUpdating = False    Application.DisplayAlerts = False    ' 遍历文件夹中所有Excel文件（可根据需要修改扩展名）    fileName = Dir(fldPath & "*.xls*")    i = 0    Do While fileName <> ""        ' 打开源工作簿（只读方式）        Set srcWB = Workbooks.Open(fldPath & fileName, ReadOnly:=True)        ' 复制源文件的第一个工作表到目标工作簿的最后        srcWB.Sheets(1).Copy After:=destWB.Sheets(destWB.Sheets.Count)        Set destSheet = destWB.Sheets(destWB.Sheets.Count)        ' 生成工作表名称：去掉扩展名        sheetName = Left(fileName, InStrRev(fileName, ".") - 1)        ' 若名称长度超过31字符则截断（Excel工作表名限制）        If Len(sheetName) > 31 Then sheetName = Left(sheetName, 31)        ' 若重名则添加数字后缀        If SheetExists(sheetName, destWB) Then            Dim suffix As Integer            suffix = 1            Do While SheetExists(sheetName & "_" & suffix, destWB)                suffix = suffix + 1            Loop            sheetName = sheetName & "_" & suffix        End If        destSheet.Name = sheetName        ' 关闭源工作簿，不保存        srcWB.Close SaveChanges:=False        i = i + 1        fileName = Dir()   ' 下一个文件    Loop    ' 恢复设置    Application.ScreenUpdating = True    Application.DisplayAlerts = True    MsgBox "合并完成！共合并了 " & i & " 个文件。", vbInformationEnd Sub' 辅助函数：检查指定工作簿中是否存在某工作表Private Function SheetExists(sheetName As String, wb As Workbook) As Boolean    On Error Resume Next    SheetExists = Not (wb.Sheets(sheetName) Is Nothing)    On Error GoTo 0End Function