VBA 代码中的单个单元格无法正确粘贴答案

【问题标题】：Individual Cells In VBA Code Do Not Paste CorrectlyVBA 代码中的单个单元格无法正确粘贴
【发布时间】：2021-04-09 21:45:09
【问题描述】：

我有一些代码可以移动活动行中的数据，以便根据需要在行上留出间隙。然后它从第 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 个单元格副本会发生这种情况，这对我来说似乎很奇怪。

谢谢大家。

【问题讨论】：

你能告诉你运行代码时Selection是什么地址吗？
它会有所不同，因为用户将转储 1 到 X 个新行的数据，然后选择这些行然后运行代码。 [(imgur.com/6UBigZz.png)]
请阅读minimal reproducible example，然后给我们举一个输入数据和输出数据的例子（截图可能会有很大帮助）。对于您给出的示例，请指定用于此特定示例的Selection 地址。 • 我们需要能够重现您遇到的问题。
uhhh，请不要将 cmets 用于数据或代码。你可以edit你的原始问题。
抱歉，我在试图弄清楚如何向您展示一些示例数据时遇到了一些麻烦。 @Pᴇʜ 这个 gif 应该更好地解释它，在这里你可以看到它从单元格 U6 复制的内容，然后粘贴到 U11:Y11 而不是 just U11。 (imgur.com/8XodOT6.gif)

标签： excel vba

【解决方案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我没有检查他们，他们可能已经改变了。

【讨论】：

干杯，我设法做了类似的事情，基本上按照你在答案中的安排，将 1 个单元格引用移动到顶部，然后它在没有额外变量的情况下工作。但是，我怀疑你的方式更健壮，所以我会接受你的回答。再次感谢您的帮助。我很早就开始接触 VBA，在我的工作中很少需要它，所以还需要一段时间！

【解决方案2】：

我设法通过将仅复制 1 个单元格的单元格引用移动到循环顶部来解决它。

我还通过将第二组代码复制和粘贴到仅 1 个循环而不是每次复制和粘贴一个循环来提高效率。无论如何，这使它可以脱离我的意图的原始选择。

【讨论】：