如何复制并粘贴到下一行答案

【问题标题】：How to copy and paste to the next row如何复制并粘贴到下一行
【发布时间】：2019-05-15 00:51:42
【问题描述】：

我正在创建一个带有数据输入页面的数据库，然后使用一个按钮将其粘贴到主表中。

我习惯于处理代码和编辑现有的东西，但这是我第一次不得不从头开始。

我想做的是复制数据输入单元格并粘贴到主表上的相应列中，每次都开始一个新行。

例如数据输入表上的单元格 C5 复制到主文件的 A 列，C7 复制到 B 列等。

我设法让它复制，但只单独执行每个单元格（理想情况下，我喜欢一次性复制和粘贴所有单元格，作为一个范围而不是单独的每个单元格），但无论我从所有页面尝试什么在这里我每次都不能让它去下一行。

复制和粘贴有效：

Sheets("RAW DATA").Range("Ak2").PasteSpecial Paste:=xlPasteValues
Sheets("Enter Accident").Range("Q19").Copy
Sheets("RAW DATA").Range("AL2").PasteSpecial Paste:=xlPasteValues
Sheets("Enter Accident").Range("Q21").Copy
Sheets("RAW DATA").Range("AM2").PasteSpecial Paste:=xlPasteValues
Sheets("Enter Accident").Range("Q23").Copy
Sheets("RAW DATA").Range("AN2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

我试过了，但没用：

Sheets("Enter Accident").Range("C3, C5, C7, C9, C11, C13 ,C15, C17, C19, C21, C23, C25, C27, C29, C31, G3, G11, G13, G15, G17, G19, G21, G23, G25, G31, L3, L11, L13, L15, L19, L21, Q3, Q5, Q7, Q9, Q11, Q15, Q17, Q19, Q21, Q23").Copy
Sheets("RAW DATA").Range("A2, B2, C2, D2, E2, F2, G2, H2, I2, J2, K2, L2, M2, N2, O2, P2, Q2, R2, S2, T2, U2, V2, W2, Z2, Y2, AA2, AB2, AC2, X2, AD2, AE2, AF2, AG2, AH2, AI2, AJ2, AK2, AL2, AM2, AN2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

这些都不适用于添加最后一行的任何交互，例如：

Dim lastrow As Range
Set lastrow = Sheets("RAW DATA").Cells.SpecialCells(xlCellTypeLastCell).EntireRow + 1

【问题讨论】：

是不是每次移动1列就想跳2行的问题？

标签： excel vba

【解决方案1】：

一种方法。如果您的范围可能会有所不同，最好使用 OFFSET 和循环。

Sub x()

Dim vCopy, vPaste, i As Long

vCopy = Array("C3", "C5", "C7", "C9", "C11", "C13 ,C15", "C17", "C19", "C21", "C23", "C25", "C27", "C29", "C31", "G3", "G11", "G13", "G15", "G17", "G19", "G21", "G23", "G25", "G31", "L3", "L11", "L13", "L15", "L19", "L21", "Q3", "Q5", "Q7", "Q9", "Q11", "Q15", "Q17", "Q19", "Q21", "Q23")
vPaste = Array("A2", "B2", "C2", "D2", "E2", "F2", "G2", "H2", "I2", "J2", "K2", "L2", "M2", "N2", "O2", "P2", "Q2", "R2", "S2", "T2", "U2", "V2", "W2", "Z2", "Y2", "AA2", "AB2", "AC2", "X2", "AD2", "AE2", "AF2", "AG2", "AH2", "AI2", "AJ2", "AK2", "AL2", "AM2", "AN2")

For i = LBound(vCopy) To UBound(vCopy)
    Sheets("RAW DATA").Range(vPaste(i)).Value = Sheets("Enter Accident").Range(vCopy(i)).Value
Next i

End Sub

为避免覆盖，请找到最后一行并向下移动一个单元格。

Sub x()

Dim vCopy, i As Long, rPaste As Range

vCopy = Array("C3", "C5", "C7", "C9", "C11", "C13 ,C15", "C17", "C19", "C21", "C23", "C25", "C27", "C29", "C31", "G3", "G11", "G13", "G15", "G17", "G19", "G21", "G23", "G25", "G31", "L3", "L11", "L13", "L15", "L19", "L21", "Q3", "Q5", "Q7", "Q9", "Q11", "Q15", "Q17", "Q19", "Q21", "Q23")

Set rPaste = Sheets("RAW DATA").Cells(Rows.Count, 1).End(xlUp)(2)

For i = LBound(vCopy) To UBound(vCopy)
    rPaste.Value = Sheets("Enter Accident").Range(vCopy(i)).Value
    Set rPaste = rPaste.Offset(, 1)
Next i

End Sub

【讨论】：

复制粘贴很有效，非常感谢 - 将节省我在其他表单上的大量时间 :)
但是它覆盖了已经存在的数据 - 有没有办法让它粘贴到下一个空白行？
太棒了，你们都太棒了！像魅力一样工作

【解决方案2】：

您是众多人中的一员，在没有必要时将数据复制到剪贴板。我们来看看这段代码：

Sheets("Enter Accident").Range("Q19").Copy
Sheets("RAW DATA").Range("AL2").PasteSpecial Paste:=xlPasteValues

这完全一样：

Sheets("RAW DATA").Range("AL2").Value = Sheets("Enter Accident").Range("Q19").Value

除了：

由于您不通过剪贴板，它会更快。
如果您已经将某些内容放入剪贴板，则不会被覆盖。

SJR 的回答是对此解释的详细说明。

【讨论】：