Vba 将另一工作表中的数据粘贴到循环中的下一行

我需要打开一个对话框并选择一个工作簿。然后复制该工作簿中的数据（该工作簿始终只有一张同名的工作表）

我想通过使用vbyesno循环对许多工作簿执行此过程

这是唯一不起作用的部分，因为我想将数据粘贴到范围（“a14”）下，然后循环，然后粘贴到a14中粘贴的数据下

下面是从另一个宏调用的宏

Sub prompt()

    Application.DisplayAlerts = False
    Dim Target_Workbook As Workbook
    Dim Source_Workbook As Workbook
    Dim Target_Path As Range
    d = MsgBox("Add record?", vbYesNoCancel + vbInformation)
    If d = vbNo Then
        ActiveSheet.Range("a13").value = "No data Found"
        ActiveSheet.Range("a13").Font.Bold = True
        ThisWorkbook.Save
    ElseIf d = vbCancel Then
        Sheets("MPSA").Delete
        ThisWorkbook.Save
    ElseIf d = vbYes Then
        Sheets("MPSA").Range("a14").value = "NAME"
        Sheets("MPSA").Range("b14").value = "NUMBER"
        Sheets("MPSA").Range("c14").value = "AGR NUMBER"
        Sheets("MPSA").Range("d14").value = "ENTITY NAME"
        Sheets("MPSA").Range("e14").value = "GROUP"
        Sheets("MPSA").Range("f14").value = "DELIVERABLE"
        Sheets("MPSA").Range("g14").value = "DELIVERAB"
        Sheets("MPSA").Range("h14").value = "IS COMPON"
        Sheets("MPSA").Range("i14").value = "PACKAGE"
        Sheets("MPSA").Range("j14").value = "ORDERS"
        Sheets("MPSA").Range("k14").value = "LICNTITY"
        Sheets("MPSA").Range("l14").value = "QUANTITY"
        Sheets("MPSA").Range("m14").value = "ORDERANUMBER"
        Sheets("MPSA").Range("n14").value = "ORDERAM NAME"
        Sheets("MPSA").Range("o14").value = "PAC NUMBER"
        Sheets("MPSA").Range("p14").value = "PACKAGAME"
        Sheets("MPSA").Range("q14").value = "ITTION"
        Sheets("MPSA").Range("r14").value = "LICENSE TYPE"
        Sheets("MPSA").Range("s14").value = "ITEM VERSION"
        Sheets("MPSA").Range("t14").value = "REAGE"
        Sheets("MPSA").Range("u14").value = "CLIIT"
        Sheets("MPSA").Range("v14").value = "LICEAME"
        Sheets("MPSA").Range("w14").value = "ASSATE"
        Sheets("MPSA").Range("x14").value = "ASSTE"
        Sheets("MPSA").Range("y14").value = "ENTITTUS"
        Sheets("MPSA").Range("z14").value = "ASSGORY"
        Sheets("MPSA").Range("aa14").value = "PURCHAYPE"
        Sheets("MPSA").Range("ab14").value = "BILLTHOD"
        Sheets("MPSA").Range("ac14").value = "SALETER"
        Cells.Columns.AutoFit
        Target_Path = Application.GetOpenFilename
        Set Target_Workbook = Workbooks.Open(Target_Path)
        Set Source_Workbook = ThisWorkbook

        Target_Data = Target_Workbook.Sheets(1).Range("A1").CurrentRegion.Copy
        Target_Workbook.Close
        Source_Workbook.Sheets("MPSA").Range("a14").End(xlDown).Offset(1, 0).PasteSpecial = Target_Data
        ActiveCell.EntireRow.Delete
        ThisWorkbook.Save
        ThisWorkbook.Save
    End If
End Sub

---

我打算提出一种实现循环的机制，假设您当前的代码接近您想要实现的目标。但是我发现了很多错误，所以我不得不重构它，希望它能让你更进一步

以下代码将继续循环，直到用户在“文件”对话框中按“取消”：

Sub prompt()
    Dim d As VbMsgBoxResult: d = MsgBox("Add record?", vbYesNoCancel + vbInformation)
    If d = vbNo Then
        Sheets("MPSA").Range("a13").value = "No data Found"
        Sheets("MPSA").Range("a13").Font.Bold = True
        ThisWorkbook.Save
        Exit Sub
    End If
    If d = vbCancel Then
        Sheets("MPSA").Delete
        ThisWorkbook.Save
        Exit Sub
    End If

    On Error GoTo Cleanup
    Application.DisplayAlerts = False: Application.EnableEvents = False: Application.ScreenUpdating = False

    Sheets("MPSA").Range("a14:ac14").value = Array( _
    "NAME", "NUMBER", "AGR NUMBER", "ENTITY NAME", "GROUP", "DELIVERABLE", "DELIVERAB", "IS COMPON", _
    "PACKAGE", "ORDERS", "LICNTITY", "QUANTITY", "ORDERANUMBER", "ORDERAM NAME", "PAC NUMBER", "PACKAGAME", _
    "ITTION", "LICENSE TYPE", "ITEM VERSION", "REAGE", "CLIIT", "LICEAME", "ASSATE", "ASSTE", _
    "ENTITTUS", "ASSGORY", "PURCHAYPE", "BILLTHOD", "SALETER")

    Sheets("MPSA").Columns.AutoFit
    Dim Target_Path: Target_Path = Application.GetOpenFilename
    Do While Target_Path <> False ' <-- loop until user cancels
        Dim Target_Workbook As Workbook: Set Target_Workbook = Workbooks.Open(Target_Path)
        Target_Workbook.Sheets(1).Range("A1").CurrentRegion.Copy _
            ThisWorkbook.Sheets("MPSA").Range("a1000000").End(xlUp).Offset(1)
        Target_Workbook.Close False
        ActiveCell.EntireRow.Delete
        ThisWorkbook.Save
        Target_Path = Application.GetOpenFilename
    Loop
Cleanup:
    If Err.Number <> 0 Then MsgBox "Something went wrong: " & vbCrLf & Err.Description
    Application.DisplayAlerts = True: Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

子提示符（）
将d调整为VbMsgBoxResult:d=MsgBox（“添加记录？”，vbYesNoCancel+vbInformation）
如果d=vbNo，则
表格（“MPSA”）.范围（“a13”）.值=“未找到数据”
图纸（“MPSA”）。范围（“a13”）。Font.Bold=True
此工作簿。保存
出口接头
如果结束
如果d=vbCancel，则
表格（“MPSA”）。删除
此工作簿。保存
出口接头
如果结束
关于错误转到清理
Application.DisplayAlerts=False:Application.EnableEvents=False:Application.ScreenUpdate=False
表（“MPSA”）。范围（“a14:ac14”）。值=数组（_
“名称”、“编号”、“AGR编号”、“实体名称”、“集团”、“可交付成果”、“可交付成果”、“是组成部分”_
“包装”、“订单”、“合法性”、“数量”、“订单编号”、“订单名称”、“PAC编号”、“包装游戏”_
“ITTION”、“许可证类型”、“项目版本”、“REAGE”、“CLIIT”、“许可证名称”、“ASSATE”、“ASSTE”_
“ENTITTUS”、“ASSGORY”、“PURCHAYPE”、“BILLTHOD”、“SALETER”）
图纸（“MPSA”）.Columns.AutoFit
Dim Target_Path:Target_Path=Application.GetOpenFilename
Do While Target_Path False'您确定此代码仅适用于一次迭代吗？如果我理解正确：这是将一个范围从一个工作表粘贴到另一个工作表的代码。因此，您需要编写调用对话框以突出显示所需工作簿的代码，修改并调用此粘贴代码以在工作表底部添加范围数据，然后迭代该代码，直到用户单击“停止”。你不觉得这要求很多志愿者吗？你自己试试代码，我们会帮你解决问题。非常感谢，你的代码工作得很好，但是我需要一些不同的东西。我会解释亲爱的@Ashwendra，我认为我们需要一个接一个地以不同的方式进行：）。据我所知，上面的代码提供了一个解决方案，但您需要更改流程，因此我建议您关闭此问题，并提出一个与所需更改完全对应的新问题。当然，我和其他许多人都很乐意帮忙。你好@A.S.H，网站不允许我再问其他问题。你能帮我做这个吗。。。。在您的代码中…每次选择要从中复制数据的新工作表时，我都需要删除第一行。你能帮我做这行吗？试一下
Target\u工作簿.Sheets（1）.Range（“A1”）.CurrentRegion.Offset（1）.复制一下
Man，你是个传奇人物！：）我会问一个不同的问题，并会特别地给你贴上标签：D我要等两天再问另一个问题