Excel VBA代码将列从表单复制粘贴到合并电子表格中的行

我一直在尝试为以下内容创建代码

将数据捕获到设计为表单的excel电子表格中。日期记录在B1-B48列范围内

我想把它转移到我们的汇总电子表格中，在那里我们保存了每一行填写的表格的数据。（汇总表测试）

数据应粘贴转置，并找到下一个空行，而不是重写任何其他条目

我的代码存在以下问题：-

在我的测试汇总表中，数据写入第49行。因此，它使用“表单”中的最后一个单元格来确定将数据粘贴到何处。而不是下一个空行

数据没有被粘贴到下一个空行，而是始终在写入第49行

这是我第一次尝试，温柔一点

保罗

---

---

问题是您没有指定具体的工作簿或工作表。避免使用

ActiveWorkbook

和

ActiveSheet

这不是很可靠，可能会产生不同的结果。相反，总是定义一个混凝土板（如按其名称）。另见

另外，我建议使用

选项Explicit

，并正确声明所有变量以避免任何问题

Option Explicit

Private Sub CommandButton1_Click()
    Dim DestWb As Workbook 'define destination workbook
    Set DestWb = Workbooks.Open(Filename:="https://catsprotection.sharepoint.com/sites/Crawley/FinanceDocuments/Adoptions/Testing Area/summary sheet - testing.xlsx")

    Dim DestWs As Worksheet 'define destination worksheet
    Set DestWs = DestWb.Sheet1

    Dim eRow As Long 'determine last row in destination worksheet
    eRow = DestWs.Cells(DestWs.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    If eRow >= 1 Then eRow = eRow + 1

    ThisWorkbook.Worksheets("MyFormSheet").Range("B1:B48").Copy 'copy directly before paste
    DestWs.Cells(eRow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True

    Application.CutCopyMode = False

    DestWb.Close SaveChange:=True 'close and save destination workbook
End Sub

---

你好，第19页。您的问题只是代码从表单中获取“最后一行”，而不是从摘要中获取您想要的内容。因此，代码需要临时切换到summarysheet，使用与您已有代码类似的代码获取最后一行，然后切换回表单工作表并进行复制。使用“显式”工作表名称而不是“活动工作表”来确保代码按照您认为的方式运行，您可能会从中受益。我如何添加代码以切换到汇总表。此外，为了使工作表名称更明确，如果我将工作表的名称改为“datainput”，我是否会将代码改为“datainput”或“datainputsheet”？谢谢你的帮助谢谢你的建议。但是我可以厚着脸皮，请你写一些类似的代码，我需要切换到汇总表。佩赫谢谢你的帮助，也许我对VB Excel编程了解不够。我相信这对你来说很简单，但对我来说不是。也许61岁的人不应该这样做。（微笑）。我可以厚着脸皮说。目标工作手册文件是Area/summary sheet-testing.xlsx。@Webbp19这是一个问题吗？如果是的话，那么我不明白你的问题是什么。工作表被称为-总结。数据来源的表格是HFQ问卷的区域/副本\u crawley\u 13-02-18-debug.xls，工作表称为数据输入。您推荐的代码看起来怎么样。我会在这方面做得更好，并能看到了解更多的潜力VB@Webbp19在

filename:=

和

Set DestWs=DestWb.工作表（“数据输入”）

之后使用您的文件名。如果您的问题已解决，请将此答案标记为解决方案。

Option Explicit

Private Sub CommandButton1_Click()
    Dim DestWb As Workbook 'define destination workbook
    Set DestWb = Workbooks.Open(Filename:="https://catsprotection.sharepoint.com/sites/Crawley/FinanceDocuments/Adoptions/Testing Area/summary sheet - testing.xlsx")

    Dim DestWs As Worksheet 'define destination worksheet
    Set DestWs = DestWb.Sheet1

    Dim eRow As Long 'determine last row in destination worksheet
    eRow = DestWs.Cells(DestWs.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    If eRow >= 1 Then eRow = eRow + 1

    ThisWorkbook.Worksheets("MyFormSheet").Range("B1:B48").Copy 'copy directly before paste
    DestWs.Cells(eRow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True

    Application.CutCopyMode = False

    DestWb.Close SaveChange:=True 'close and save destination workbook
End Sub