Excel 按钮将特定数据从一个工作簿复制到另一个工作簿

Workbook1

是我所有数据所在的位置。

Workbook2

是我要复制数据的地方。

我想要一个按钮来执行以下操作：
-打开工作簿2
-从工作簿1复制数据单元格（列出）： C3、S3、P3、J22、L22、J21、L21、C14、C15、C16、C17、C18、C19、C20、C21
-在工作簿2中查找下一个空行
-将数据水平粘贴到工作簿2中。所以C3（来自workbook1）数据将粘贴到B4（来自workbook2），S3将粘贴到C4，以此类推。

这可能不太可能，但有没有办法让列a显示该特定行的数据传输日期？

任何建议都将不胜感激！

如果你需要进一步解释，请告诉我

Private Sub CommandButton2_Click()

Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngToCopy As Range
Dim C As Long
Dim ar As Range
Dim cl As Range

Dim LastRow As Long
Dim rngDestination As Range

Set wsMain = ThisWorkbook.ActiveSheet

Application.DisplayAlerts = False

' to open the workbook
Set wbData = Workbooks.Open("A:\folder\workbook2.xlsm", True)
Set wsData = wbData.Sheets("Completed")
Set rngToCopy = wsMain.Range("C3,S3,P3,J22,L22,J21,L21,C14,C15,C16,C17,C18,C19,C20,C21")

' to get the last row in the Completed worksheet
LastRow = wsData.Cells(wsData.Rows.Count, "B4").End(x1Up).Row

C = 1

For Each cl In rngToCopy
    cl.Copy
    wsData.Range("B" & C).PasteSpecial xlPasteValues
    C = C + 1

Next cl
End Sub

---

我要更改此项的粘贴代码：

Private Sub CommandButton2_Click()

Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngToCopy As Range
Dim C As Long
Dim ar As Range
Dim cl As Range

Dim LastRow As Long
Dim rngDestination As Range

Set wsMain = ThisWorkbook.ActiveSheet

Application.DisplayAlerts = False

' to open the workbook
Set wbData = Workbooks.Open("A:\folder\workbook2.xlsm", True)
Set wsData = wbData.Sheets("Completed")


' to get the last row in the Completed worksheet
LastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Row

' to paste the values
wsMain.Range("C3,S3,P3,J22,L22,J21,L21,C14,C15,C16,C17,C18,C19,C20,C21").Copy
wsData.Range("B" & LastRow).PasteSpecial xlPasteValues

'to get the Date and time when it was pasted
wsData.Range("A" & Lastrow) = Now()

End Sub

---

也许这样行。。看起来代码的最后一部分是垂直粘贴值，而不是水平粘贴值。我进行了修改，使其水平粘贴值

Private Sub CommandButton2_Click()

Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngToCopy As Range
Dim C As Long
Dim ar As Range
Dim cl As Range

Dim LastRow As Long
Dim rngDestination As Range

Set wsMain = ThisWorkbook.ActiveSheet

Application.DisplayAlerts = False

' to open the workbook
Set wbData = Workbooks.Open("A:\folder\workbook2.xlsm", True)
Set wsData = wbData.Sheets("Completed")
Set rngToCopy = wsMain.Range("C3,S3,P3,J22,L22,J21,L21,C14,C15,C16,C17,C18,C19,C20,C21")

' to get the last row in the Completed worksheet
LastRow = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row 'get the last row number in Column B.


C = 1 'nth columns to go to right when codes iterate

For Each cl In rngToCopy
    cl.Copy
    wsData.Cells(LastRow + 1, 1 + C).PasteSpecial xlPasteValues ' Start from the last empty row (lastrow number + 1) and then start from column A (A = 1) then jump 1 step to the right in each iteration/loop.
    C = C + 1 'Increase the column number by 1
    wsData.Range("A" & LastRow + 1) = Now() ' Set date in column A for the row that was pasted
Next cl
End Sub

---

你好欢迎光临！请阅读并通读，以了解我们将如何帮助您。简短版本：这不是一个代码编写服务，因此您必须提供最佳解决方案，并指出您遇到的问题，然后有人将帮助您解决该特定问题。很抱歉，我已添加了代码。L.BAER您的代码正在执行您想要的操作，把所有的东西都贴在新书上，不是吗？你的问题是什么？Damian，我一直收到运行时错误“1004”：当我调试它时，它会突出显示。。。LastRow=wsData.Cells（wsData.Rows.Count，“B4”）.End（x1Up）。行+1按如下方式重试。。。我看到现在您使用x1up而不是xlUpI进行了更改，对于相同的codeLastRow=wsData.Range（“B1”）.End（xlDown”）.Row+1尝试此操作，如果中间没有空白单元格，它将获得最后一行帮助：）！！