Question

我需要打开一个对话框并选择一个工作簿。然后复制放置在该工作簿中的数据（该工作簿中只有1张具有相同名称的工作表）。

我想通过使用vbyesno的循环来为许多工作簿执行此过程。

这是唯一不起作用的部分，因为我想在Range（＆＃34; a14＆＃34;）下粘贴数据，然后循环然后粘贴到14中粘贴的数据下。

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

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

我打算提出一种实现循环的机制，假设您当前的代码位于 near 的位置。但是我发现了许多错误，所以我不得不重构它，希望它会让你更进一步。

以下代码将继续循环，直到用户在文件对话框中按下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

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

1 个答案: