关闭工作簿 保存更改 不工作

Question

我已经构建了以下代码

Sub Merge_File_based()
' Merge files based on Names

Dim AMITRETURN As String
Dim JPRETURN As String

Dim Folderpath As String
Dim counter1 As Integer
Dim counter2 As Integer
Dim Finalrow As Integer

    Dim wb As Workbook: Set wb = ThisWorkbook

    sh = Sheets("First Step").Name

    Finalrow = Sheets(sh).Range("A1000").End(xlUp).Row

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False



    Folderpath = Fpath & "\"



    For counter1 = 2 To Finalrow Step 2
        counter2 = counter1 + 1


    AMITRETURN = wb.Sheets(sh).Cells(counter1, 1)
    JPRETURN = wb.Sheets(sh).Cells(counter2, 1)

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

    Workbooks.Open Filename:=Folderpath & AMITRETURN, UpdateLinks:=0
    Workbooks.Open Filename:=Folderpath & JPRETURN, UpdateLinks:=0


    Windows(JPRETURN).Activate

    Sheets(Array("AMIT Tax Return", "AMIT Tax Schedule")).Select
    Sheets("AMIT Tax Schedule").Activate
    Workbooks(JPRETURN).Sheets(Array("AMIT Tax Return", "AMIT Tax Schedule").Copy after:=Workbooks(AMITRETURN).Sheets("AMIT_form")

    'Ensure Workbook has closed before moving on to next line of code
     DoEvents

    Workbooks(AMITRETURN).Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
     DoEvents

    Workbooks(JPRETURN).Close SaveChanges:=False

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    Next

    MsgBox "Task Complete"

End Sub

但是当 Workbooks(AMITRETURN).Close SaveChanges:=True 在循环中运行时，它不会保存工作簿，而是问我一个问题，您是否要保存工作簿。如果我回答是，它会给出错误 dochshare Integration not working 等等。

所以我点击否，因为我想保存工作簿，一旦宏完成循环，它允许我毫无问题地保存这些文件。

此外，当我进入宏查看错误时，它允许我毫无问题地保存文件。它只是它产生问题的循环，知道我在这里缺少什么吗？

Answer 1

我相信这应该可以解决您的问题，您在循环中启用了 .DisplayAlerts，而且您的 .Select 和 .Activate 是不必要的。
我不完全确定是否需要您的 DoEvents，但无论如何我都将它们放在“正确”的位置

Option Explicit
Sub Merge_File_based()
' Merge files based on Names

Dim AMITRETURN As String
Dim JPRETURN As String

Dim Folderpath As String
Dim counter1 As Long
Dim counter2 As Long
Dim Finalrow As Long
Dim sh as Worksheet

Set sh = ThisWorkbook.Sheets("First Step")

Finalrow = sh.Range(sh.Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Folderpath = Fpath & "\"

For counter1 = 2 To Finalrow Step 2
    counter2 = counter1 + 1

    AMITRETURN = sh.Cells(counter1, 1)
    JPRETURN = sh.Cells(counter2, 1)

    Workbooks.Open Filename:=Folderpath & AMITRETURN, UpdateLinks:=0
    Workbooks.Open Filename:=Folderpath & JPRETURN, UpdateLinks:=0

    Workbooks(JPRETURN).Sheets(Array("AMIT Tax Return", "AMIT Tax Schedule")).Copy after:=Workbooks(AMITRETURN).Sheets("AMIT_form")

    Workbooks(AMITRETURN).Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

    Workbooks(JPRETURN).Close SaveChanges:=False

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

MsgBox "Task Complete"

End Sub