Excel VBA 不会关闭我打开的工作簿

Question

I am pretty much new to VBA and have been trying to learn, with this I have created a code that opens another work book and combines all data to a database file and then copy this to my current open file, the problem I have is that it will not close the workbook and takes a long time doing so. Any ideas please?.

    '''
    Option Explicit

    Sub GasStockReport()

    Dim wb As String
    Dim st As String
    Dim path As String
    path = "C:\Users\si2066\OneDrive - ENGIE\Desktop\MP Templates\MP - Stock Control\"
    wb = "Gas Stock Take v2"

    Workbooks.Open path & wb

    Dim sh As Worksheet
    Dim destsh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Database").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    Set destsh = ActiveWorkbook.Worksheets.Add
    destsh.Name = "Database"

    For Each sh In ActiveWorkbook.Worksheets

    If sh.Name <> destsh.Name Then

        Last = GetLastRow(destsh, 1)

        With sh
            Set CopyRng = sh.Range("A2:K" & GetLastRow(sh, 1))
        End With

        If Last + CopyRng.Rows.Count > destsh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        Else

           CopyRng.Copy IIf(Last = 1, destsh.Cells(1, "b"), destsh.Cells(Last + 1, "b"))

        End If

        If Last = 1 Then
            destsh.Cells(Last, "A").Resize(CopyRng.Rows.Count).Value = sh.Name
        Else
             destsh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name
        End If

    End If
    Next

    ExitTheSub:

    Application.Goto destsh.Cells(1)
    destsh.Columns.AutoFit

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With

    Range("A1").Select
    Range(Selection, ActiveCell.End(xlDown).End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.SelectedSheets.Visible = False


    ThisWorkbook.Sheets("Stock History").Activate
    Range("N1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Application.DisplayAlerts = False
    On Error Resume Next
    Workbooks("Gas Stock Take v2").Close SaveChanges:=True
    On Error GoTo 0
    Application.DisplayAlerts = True


    ThisWorkbook.Sheets("Stock Take").Activate

    Call Click

    End Sub




    Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) 
    As Long

    With ws

    GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row

    End With

    End Function
    '''

Answer 1

Your error handling is fine. Using On Error GoTo 0 turns off On Error Resume Next .

I think the issue is the amount of data you're leaving on the clipboard after copy and paste. If you use .copy and .paste always follow that up with Application.CutCopyMode = False