Excel宏自动化需求：按规则循环处理1892行复制粘贴

需求说明 #

需要处理「Sales data」表中第258行至1892行的数据，按以下规则批量复制到「Sales per month」表：

• 每行的F:N列，转置粘贴到「Sales per month」表的G列，起始行从2306开始，每次目标行递增9行；
• 每行的A:E列，粘贴到「Sales per month」表的对应起始行（与上述G行一致），并覆盖从起始行到起始行+8的9行区域。

现有宏代码 #

Sheets("Sales data").Select
Range("F258:N258").Select
Selection.Copy
Sheets("Sales per month").Select
Range("G2306").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
ActiveWindow.SmallScroll Down:=6
Sheets("Sales data").Select
Range("A258:E258").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sales per month").Select
Range("A2306:E2314").Select
ActiveSheet.Paste
Range("C2297").Select

Sheets("Sales data").Select
Range("F259:N259").Select
Selection.Copy
Sheets("Sales per month").Select
Range("G2315").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
ActiveWindow.SmallScroll Down:=6
Sheets("Sales data").Select
Range("A259:E259").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sales per month").Select
Range("A2315:E2323").Select
ActiveSheet.Paste
Range("C2297").Select

修改后的自动化循环宏代码 #

Sub BatchCopySalesData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceRow As Long
    Dim targetStartRow As Long
    Dim rowOffset As Long
    
    ' 定义工作表对象，避免反复切换选择
    Set wsSource = ThisWorkbook.Sheets("Sales data")
    Set wsTarget = ThisWorkbook.Sheets("Sales per month")
    
    ' 关闭屏幕更新，提升运行速度
    Application.ScreenUpdating = False
    
    ' 循环处理源表第258行到1892行
    For sourceRow = 258 To 1892
        ' 计算目标起始行：初始2306，每处理一行源数据，目标行增加9行
        rowOffset = (sourceRow - 258) * 9
        targetStartRow = 2306 + rowOffset
        
        ' 复制源行F:N列，转置粘贴到目标表G列的对应行
        wsSource.Range("F" & sourceRow & ":N" & sourceRow).Copy
        wsTarget.Range("G" & targetStartRow).PasteSpecial _
            Paste:=xlPasteAll, Transpose:=True
        
        ' 复制源行A:E列，粘贴到目标表A-E列的9行区域
        wsSource.Range("A" & sourceRow & ":E" & sourceRow).Copy
        wsTarget.Range("A" & targetStartRow & ":E" & targetStartRow + 8).PasteSpecial _
            Paste:=xlPasteAll
    Next sourceRow
    
    ' 清除复制模式，恢复屏幕更新
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "数据批量复制完成！", vbInformation
End Sub

代码优化说明 #

1. 避免Select/Selection：直接通过工作表对象引用单元格范围，减少界面切换，提升运行效率并避免因选中区域变化导致的错误；
2. 循环逻辑：用For循环遍历源表指定行，通过rowOffset计算目标行的递增关系，无需手动修改每行的范围；
3. 性能优化：关闭ScreenUpdating避免运行过程中屏幕闪烁，大幅提升处理速度；
4. 清晰的变量定义：明确源表和目标表对象，代码可读性更强，后续维护更方便。

内容的提问来源于stack exchange，提问作者Silvia González