VBA复制粘贴宏优化求助：基于锚点偏移量简化重复逻辑

Let's eliminate that repetitive code once and for all! The core issue with your original Offset attempt was incorrect syntax and not anchoring your paste position properly. Instead of writing 30 identical blocks, we'll define all your copy-paste scenarios in a single configurable list, then loop through them cleanly.

Step 1: Anchor to D13 & Find Your Paste Column #

First, we'll use your anchor cell D13 to locate the next empty column for pasting—this stays consistent across all operations:

Dim targetCol As Long
targetCol = pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Column + 1

Step 2: Define All Scenarios in an Array #

We'll store each copy-paste task as a set of parameters, so you only need to add new entries instead of rewriting code:

• Source range's offset from D13 (rows, columns)
• Source range size (rows, columns)
• Target row offset from row 13 (since we're pasting into the new targetCol)

Full Optimized Code #

Sub CopyPasteWithOffsets()
    Application.ScreenUpdating = False
    Dim copySheet As Worksheet, pasteSheet As Worksheet
    Dim targetCol As Long
    Dim copyScenarios As Variant
    Dim i As Long
    
    ' Set your worksheets (kept flexible even though they're the same here)
    Set copySheet = Worksheets("Calculation")
    Set pasteSheet = Worksheets("Calculation")
    
    ' Get the next empty column to paste into (starting from D13's row)
    targetCol = pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Column + 1
    
    ' Define all your copy-paste scenarios here
    ' Each entry: [sourceOffsetRows, sourceOffsetCols, sourceRows, sourceCols, targetOffsetRows]
    copyScenarios = Array( _
        Array(0, 0, 1, 2, 0), ' D13 MergeArea → target row 13
        Array(1, 0, 17, 2, 1), ' D14:E30 (17 rows) → target row 14
        Array(18, 0, 1, 2, 18), ' D31 MergeArea → target row 31
        Array(19, 0, 2, 2, 19), ' D32:E33 (2 rows) → target row 32
        Array(150, 0, 1, 2, 150), ' D163 MergeArea → target row 163
        Array(151, 0, 4, 2, 151) ' D164:E167 (4 rows) → target row 164
    )
    
    ' Loop through each scenario and execute copy-paste
    For i = LBound(copyScenarios) To UBound(copyScenarios)
        With copyScenarios(i)
            ' Define source range using offset from D13
            Dim sourceRange As Range
            Set sourceRange = copySheet.Range("D13").Offset(.Item(0), .Item(1)).Resize(.Item(2), .Item(3))
            
            ' Handle merged ranges automatically
            If sourceRange.MergeCells Then
                Set sourceRange = sourceRange.MergeArea
            End If
            
            ' Paste to the target column with row offset
            sourceRange.Copy
            pasteSheet.Cells(13 + .Item(4), targetCol).PasteSpecial xlPasteAll
        End With
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

How to Add More Scenarios #

To add your 30+ additional tasks, just extend the copyScenarios array with new entries following the same pattern:

Array(rowOffsetFromD13, colOffsetFromD13, numRowsInSource, numColsInSource, targetRowOffsetFrom13)

For example, if you need to copy D170:E185 (16 rows) and paste it starting at row 170 in the new column, add:

Array(157, 0, 16, 2, 157)

(157 comes from 170 - 13, since D13 is row 13)

Why Your Original Offset Code Failed #

Your line copySheet.Offset(17, 1).Copy ("D14:E30") had two key issues:

1. copySheet is a Worksheet object—you can't use Offset directly on it; you need to call Offset on a Range object (like copySheet.Range("D13").Offset(...)).
2. The Copy method syntax was incorrect—you don't wrap the target range in parentheses like that. Instead, define the target separately and use PasteSpecial.

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