Вставить данные из другого листа в следующую строку в цикле

Question

Мне нужно открыть диалоговое окно и выбрать книгу. Затем скопируйте данные, помещенные в эту книгу (которая имеет только 1 лист с одинаковым именем все время).

Я хочу сделать процесс для многих книг, используя цикл для vbyesno.

Это единственная часть, которая не работает, потому что я хочу вставлять данные под Range ("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 

Answer 1

Я собирался предложить механизм для достижения петли, полагая, что ваш текущий код находится где-то рядом то, что вы хотите достичь. Но я нашел много ошибок, поэтому мне пришлось реорганизовать его, надеюсь, это еще больше сделает вам шаг.

Следующий код будет продолжать цикл до тех пор пока пользователь не нажмет Cancel в диалоговом окне файла:

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