嵌套循环VBA需求：按工作表名匹配目标工作簿复制工作表

问题诊断 #

原代码的核心问题在于目标工作簿匹配逻辑错误：

• 错误使用InStr(wbFile.Name, ws)，ws是工作表对象，需用ws.Name获取工作表名称；
• fso.GetExtensionName()的参数应为文件路径/文件名，而非InStr返回的位置数值，这直接导致判断条件失效，所有文件都被执行复制操作。

修正后的代码 #

Sub updates()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim fso As Object
    Dim fldr As Object
    Dim wbFile As Object
    
    '初始化文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("C:\Users\report")
    
    Application.ScreenUpdating = False
    
    '遍历当前工作簿中索引大于2的工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index > 2 Then
            '遍历目标文件夹中的所有文件
            For Each wbFile In fldr.Files
                '仅处理Excel文件，且文件名包含当前工作表名称
                If fso.GetExtensionName(wbFile.Path) = "xlsx" Or fso.GetExtensionName(wbFile.Path) = "xls" Then
                    If InStr(1, wbFile.Name, ws.Name, vbTextCompare) > 0 Then 'vbTextCompare忽略大小写
                        Set wb = Workbooks.Open(wbFile.Path)
                        '将工作表复制到目标工作簿开头
                        ws.Copy Before:=wb.Sheets(1)
                        '直接操作wb对象，避免依赖ActiveWorkbook
                        wb.Save
                        wb.Close SaveChanges:=False '已执行Save，此处无需重复保存
                    End If
                End If
            Next wbFile
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
    '释放对象，优化内存
    Set wb = Nothing
    Set wbFile = Nothing
    Set fldr = Nothing
    Set fso = Nothing
End Sub

关键修改点 #

• 匹配逻辑修正：用InStr(1, wbFile.Name, ws.Name, vbTextCompare)判断文件名是否包含工作表名称，加入vbTextCompare实现大小写不敏感匹配；
• 文件类型过滤：增加判断仅处理Excel文件（.xls/.xlsx），避免遍历无关文件；
• 避免依赖ActiveWorkbook：直接操作wb对象完成保存和关闭，防止因窗口激活状态变化引发错误；
• 内存优化：添加对象释放代码，减少内存占用。

内容的提问来源于stack exchange，提问作者dcola12