vba 快速合并当前文件夹内多个excel的指定工作表到同一个excel的同名工作表并打开,避免提示下标越界

以下是可以实现您需求的 VBA 代码，它会将当前文件夹内所有扩展名为 `.xlsx` 或 `.xls` 的 Excel 文件中名为 "Sheet1" 的工作表合并到当前工作簿中名为 "Sheet1" 的工作表中。

Sub MergeWorksheets()
    Dim path As String, filename As String, sheet As Worksheet
    Dim copyRange As Range, destRange As Range
    Dim destWorkbook As Workbook, sourceWorkbook As Workbook
    
    '设置当前文件夹路径
    path = ThisWorkbook.Path & "\"
    
    '禁用屏幕更新和警告信息
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    '循环遍历当前文件夹内的所有 Excel 文件
    filename = Dir(path & "*.xls*")
    Do While filename <> ""
        '打开 Excel 文件并获取指定工作表的数据范围
        Set sourceWorkbook = Workbooks.Open(Filename:=path & filename, ReadOnly:=True)
        Set sheet = sourceWorkbook.Worksheets("Sheet1") '这里假设要合并的工作表名为 Sheet1
        Set copyRange = sheet.UsedRange
        
        '在目标工作簿中查找同名工作表，如果不存在就新建一个
        On Error Resume Next
        Set destWorkbook = Workbooks(ThisWorkbook.Name)
        Set sheet = destWorkbook.Worksheets(copyRange.Worksheet.Name)
        On Error GoTo 0
        If sheet Is Nothing Then
            Set sheet = destWorkbook.Worksheets.Add(After:=destWorkbook.Worksheets(destWorkbook.Worksheets.Count))
            sheet.Name = copyRange.Worksheet.Name
        End If
        
        '将数据复制到目标工作表中，避免下标越界
        Set destRange = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
        destRange.Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
        
        '关闭源工作簿
        sourceWorkbook.Close SaveChanges:=False
        
        '继续处理下一个文件
        filename = Dir()
    Loop
    
    '开启屏幕更新和警告信息
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    '激活目标工作簿
    destWorkbook.Activate
End Sub

请注意，此代码假设要合并的工作表名为 "Sheet1"，您可以根据需要更改该部分代码。此外，它还假设当前工作簿是目标工作簿，如果您要将数据合并到不同的工作簿中，请相应地更改代码。