时间戳

首页 > 解决方案 > 如何复制并粘贴到下一行

excel - 如何复制并粘贴到下一行

问题描述

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

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

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

例如，数据输入表上的单元格 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

标签： excelvba

解决方案

一种方法。如果您的范围可能会有所不同，最好使用 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

推荐阅读