excel - VBA 代码中的单个单元格无法正确粘贴

Question

我有一些代码可以移动事件行中的数据，以便根据需要在行上有间隙。
然后它从第 6 行复制公式以填补这些空白。
但是，当复制的单元格只是一个单独的单元格而不是一个区域时，它不会将公式粘贴到事件行中的相应单元格中，而是将第 6 行的该 1 个单元格中的数据粘贴到事件行中先前复制的区域中。
IE。如果从第 6 行复制 3 个单元格，则将 3 个单元格粘贴到事件行中。然后从第 6 行复制 1 个单元格，将 3 个单元格粘贴到事件行中。 - 这应该只粘贴 1 个。
这是代码:

Sub DeliveryDriverDataAdjust()
    
    Application.Calculation = xlManual 'Formulas are not calculated
    Application.ScreenUpdating = False 'What the user see's on screen will not change
    
    With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of column A.
        .Offset(ColumnOffset:=1).Insert Shift:=xlToRight 'Inserts X to the right of column A in the active row.
        .Offset(ColumnOffset:=2).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=12).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=13).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=14).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=15).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=16).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=20).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=22).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=23).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=27).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=28).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=29).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=33).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=34).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=35).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=37).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=38).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=39).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=40).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=43).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=44).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=45).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=46).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=47).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=48).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=49).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=50).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=51).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=52).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=53).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=54).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=55).Insert Shift:=xlToRight
        .Offset(ColumnOffset:=57).Insert Shift:=xlToRight
    End With
        
        Range("B6:C6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=1).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
        Range("M6:Q6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=12).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
        Range("U6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=20).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
        Range("W6:X6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=22).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.

        Range("AB6:AD6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=27).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.

        Range("AH6:AJ6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=33).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.

        Range("AL6:AO6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=37).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.

        Range("AR6:BD6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=43).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
        Range("BF6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=57).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
        Range("BH6:GH6").Copy 'Copies a specific cell/s
        With Selection.Offset(ColumnOffset:=1 - Selection.Column) 'Does everything based off of Column A.
        .Offset(ColumnOffset:=59).PasteSpecial 'Pastes X to the right of column A in the active row.
        End With
        Application.CutCopyMode = False 'Clears what is being copied.
        
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

MsgBox "Your data has been reordered and the formulas have been copied down."

End Sub

非常感谢任何帮助，我也怀疑现在的代码没有得到很好的优化，如果你有任何建议这样做也很好。
不知道为什么只有这 1 个单元格副本会发生这种情况，这对我来说似乎很奇怪。
谢谢大家。

Answer 1

在 gif 中您可以清楚地看到，选择更改为粘贴的范围。所以在

With Selection.Offset(ColumnOffset:=1 - Selection.Column)

您在每次粘贴后开始使用不同的 Selection它有不同的大小。
所以你应该做的是

Dim ColumnAOfSelection As Rang
Set ColumnAOfSelection = Selection.Offset(ColumnOffset:=1 - Selection.Column)

然后使用 ColumnAOfSelection因为这不再改变

    Range("B6:C6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=1).PasteSpecial 'Pastes X to the right of column A in the active row.
            
    Range("M6:Q6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=12).PasteSpecial 'Pastes X to the right of column A in the active row.
    
    Range("U6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=20).PasteSpecial 'Pastes X to the right of column A in the active row.
    
    Range("W6:X6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=22).PasteSpecial 'Pastes X to the right of column A in the active row.

    Range("AB6:AD6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=27).PasteSpecial 'Pastes X to the right of column A in the active row.

    Range("AH6:AJ6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=33).PasteSpecial 'Pastes X to the right of column A in the active row.

    Range("AL6:AO6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=37).PasteSpecial 'Pastes X to the right of column A in the active row.

    Range("AR6:BD6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=43).PasteSpecial 'Pastes X to the right of column A in the active row.
    
    Range("BF6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=57).PasteSpecial 'Pastes X to the right of column A in the active row.
    
    Range("BH6:GH6").Copy 'Copies a specific cell/s
    ColumnAOfSelection.Offset(ColumnOffset:=59).PasteSpecial 'Pastes X to the right of column A in the active row.

    Application.CutCopyMode = False 'you need this only once in the end

您可能需要调整 ColumnOffset我没有检查他们，他们可能已经改变了。