基于循环生成依赖变量X的数据并批量粘贴到多工作表的VBA循环逻辑问题

你现在的核心问题是循环嵌套顺序搞反了：当前代码先遍历目标工作表，再遍历X的每个单元格，这会导致每个工作表被重复覆盖所有X的数据，而你想要的是处理完一个X的数据，就把它同步到所有目标工作表，再处理下一个X。

另外你的代码里大量使用Select和Activate，这不仅降低运行效率，还容易因为工作表切换出错，我们可以直接通过对象引用来操作，更稳定高效。

修改后的代码 #

Option Explicit ' 强制变量声明，避免拼写错误等问题

Sub peer2()
    Dim wsPeerCode As Worksheet
    Dim wsPeerFund As Worksheet
    Dim X As Range, Y As Range
    Dim targetSheet As Worksheet
    Dim sheetNamesRange As Range
    Dim foundRange As Range
    Dim lr1 As Long, lr2 As Long
    
    ' 提前引用工作表，避免反复Activate
    Set wsPeerCode = ThisWorkbook.Sheets("Peer Code")
    Set wsPeerFund = ThisWorkbook.Sheets("Peer Fund")
    Set X = wsPeerCode.Range("J2:J11")
    Set sheetNamesRange = wsPeerCode.Range("K2:K3")
    
    ' 外层循环：遍历X的每个单元格（每个需要处理的数据）
    For Each Y In X
        ' 清理Peer Fund的F列数据
        wsPeerFund.Range("F7:F166").ClearContents
        
        ' 将当前Y的值复制到Peer Code的L2
        wsPeerCode.Range("L2").Value = Y.Value
        
        ' 复制Peer Code的N2:N161到Peer Fund的F7开始
        wsPeerCode.Range("N2:N161").Copy
        wsPeerFund.Range("F7").PasteSpecial Paste:=xlPasteValues
        
        ' 取消F列隐藏
        wsPeerFund.Range("F7").EntireColumn.Hidden = False
        
        ' 获取F列最后一行有数据的行号
        Set foundRange = wsPeerFund.Columns("F:F").Find("*", After:=wsPeerFund.Range("F167"), _
            SearchDirection:=xlPrevious, LookIn:=xlValues)
        If Not foundRange Is Nothing Then lr1 = foundRange.Row
        
        ' 取消行隐藏
        wsPeerFund.Range("F166:F" & lr1 + 1).EntireRow.Hidden = False
        
        ' 排序数据
        With wsPeerFund.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=wsPeerFund.Range("A2:A" & lr1), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange wsPeerFund.Range("A6:W" & lr1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' 复制可见区域到所有目标工作表
        wsPeerFund.Range("A5:W172").SpecialCells(xlCellTypeVisible).Copy
        
        ' 内层循环：遍历所有目标工作表，粘贴数据
        For Each targetSheet In ThisWorkbook.Worksheets
            ' 检查当前工作表是否在目标列表中
            If Not IsError(Application.Match(targetSheet.Name, sheetNamesRange, 0)) Then
                targetSheet.Range("A5").PasteSpecial Paste:=xlPasteValues
                targetSheet.Range("A5").PasteSpecial Paste:=xlPasteFormats
                
                ' 获取目标工作表F列最后一行
                Set foundRange = targetSheet.Columns("F:F").Find("*", After:=targetSheet.Range("F167"), _
                    SearchDirection:=xlPrevious, LookIn:=xlValues)
                If Not foundRange Is Nothing Then lr2 = foundRange.Row
                
                ' 隐藏指定行和F列
                targetSheet.Range("F166:F" & lr1 + 1).EntireRow.Hidden = True
                targetSheet.Range("F7").EntireColumn.Hidden = True
            End If
        Next targetSheet
        
        ' 清理剪贴板，避免弹窗提示
        Application.CutCopyMode = False
    Next Y
    
    ' 最后可以回到指定工作表（可选）
    wsPeerCode.Activate
End Sub

关键改动说明 #

• 调整循环顺序：把遍历X的循环放在外层，遍历目标工作表的循环放在内层。这样每处理完一个X的数据，就立刻同步到所有目标工作表，再处理下一个X，完全符合你的需求。
• 移除所有Select/Activate：直接通过工作表对象（比如wsPeerCode、wsPeerFund）来操作单元格，避免工作表切换带来的错误，同时提升运行速度。
• 添加变量声明：用Option Explicit强制所有变量必须声明，避免因为变量名拼写错误导致的bug；所有对象变量都明确声明类型，代码更清晰。
• 优化工作表匹配逻辑：用Application.Match检查当前工作表是否在目标名称列表中，比直接遍历单元格更高效。
• 清理剪贴板：添加Application.CutCopyMode = False避免复制后出现的剪贴板弹窗。

这样修改后，代码就可以按照你想要的逻辑运行：处理一个X的数据，复制到所有指定工作表，然后回到X循环处理下一个数据。

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