如何復制並粘貼到下一行

Question

我正在創建一個帶有數據輸入頁面的數據庫，然后使用按鈕將其粘貼到主表單中。

我習慣於處理代碼和編輯現有的東西，但這是我第一次從頭開始。

我想要它做的是復制數據輸入單元格並粘貼到主表單上的相應列，每次開始一個新行。

例如，數據輸入表上的單元格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

Answer 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

Answer 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

除了：

1. 由於您沒有通過剪貼板傳遞，它會更快。
2. 如果您已將某些內容放入剪貼板，則不會覆蓋該內容。

SJR的答案是詳細闡述這一解釋。