Vba 粘贴在工作簿事件中不起作用，但在模块中起作用

添加工作簿后的

ActiveSheet.Paste

代码在我将其放置在

模块

中时有效，但如果我将其放置在

工作簿后保存事件

中，则返回错误。当我尝试

Debug.Print（Application.ActiveSheet.Name）时，它将
Sheet1
和
Debug.Print（Application.ActiveWorkbook.Name）打印为
Book13
，所以它应该是正确的。我还尝试放置
范围（“A1”）。选择
，但它不会仍然粘贴


试试这些修订版

Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    'This section just counts total number of rows for worksheets
    Dim Total_rows_Entries As Long
    Dim Total_rows_Payees As Long
    Dim Total_rows_Accounts As Long

    'With Workbooks("ONLINE-CASH VOUCHER.xlsm")
    With ThisWorkbook

        With .Worksheets("Entries").ListObjects("Entries").ListColumns(3).Range
            Total_rows_Entries = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        With .Worksheets("List of Payees").ListObjects("ListofPayees").ListColumns(1).Range
            Total_rows_Payees = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        With .Worksheets("List of Accounts").ListObjects("ListofAccounts").ListColumns(1).Range
            Total_rows_Accounts = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        Dim copy_Path As String
        Dim lastColumn As Long, total_Rows As Long
        Dim wb As Workbook, ws As Worksheet
        Dim open_wb As Boolean

        copy_Path = "C:\Users\Asus\Desktop\"

        For Each ws In .Worksheets
            With ws
                Select Case .Name
                    Case "Entries"
                        total_Rows = Total_rows_Entries
                    Case "List of Accounts"
                        total_Rows = Total_rows_Accounts
                    Case "List of Payees"
                        total_Rows = Total_rows_Payees
                End Select
                Select Case .Name
                    Case "Entries", "List of Accounts", "List of Payees"
                        On Error Resume Next
                        Workbooks(ws.Name & ".xlsx").Close savechanges:=False
                        Set wb = Workbooks.Add
                        On Error GoTo 0

                        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
                        .Range(.Cells(1, "A"), .Cells(total_Rows, lastColumn)).Copy _
                            Destination:=wb.Worksheets(1).Cells(1, 1)
                        Application.DisplayAlerts = False
                        wb.SaveAs Filename:=copy_Path & ws.Name, FileFormat:=xlOpenXMLWorkbook
                        wb.Close savechanges:=False
                        Application.DisplayAlerts = True
                End Select
            End With
        Next

    End With

End Sub

这是在线现金凭证.xlsm工作簿中的，还是您正在激活外部工作簿？是，这是在线现金凭证.xlsm工作簿的aftersave事件。尽管ActiveSheet.Paste会在
Set wb=Workbooks.Add
之后粘贴到新的工作簿文件中。如果我将准确的代码复制并粘贴到
子测试（）
中，它将毫无问题地工作。实际上，我只是制作了一个子过程，然后我只是在aftersave事件中放置了一个
调用过程，它就工作了。只是不明白为什么它在活动中不起作用
Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    'This section just counts total number of rows for worksheets
    Dim Total_rows_Entries As Long
    Dim Total_rows_Payees As Long
    Dim Total_rows_Accounts As Long

    'With Workbooks("ONLINE-CASH VOUCHER.xlsm")
    With ThisWorkbook

        With .Worksheets("Entries").ListObjects("Entries").ListColumns(3).Range
            Total_rows_Entries = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        With .Worksheets("List of Payees").ListObjects("ListofPayees").ListColumns(1).Range
            Total_rows_Payees = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        With .Worksheets("List of Accounts").ListObjects("ListofAccounts").ListColumns(1).Range
            Total_rows_Accounts = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
        End With

        Dim copy_Path As String
        Dim lastColumn As Long, total_Rows As Long
        Dim wb As Workbook, ws As Worksheet
        Dim open_wb As Boolean

        copy_Path = "C:\Users\Asus\Desktop\"

        For Each ws In .Worksheets
            With ws
                Select Case .Name
                    Case "Entries"
                        total_Rows = Total_rows_Entries
                    Case "List of Accounts"
                        total_Rows = Total_rows_Accounts
                    Case "List of Payees"
                        total_Rows = Total_rows_Payees
                End Select
                Select Case .Name
                    Case "Entries", "List of Accounts", "List of Payees"
                        On Error Resume Next
                        Workbooks(ws.Name & ".xlsx").Close savechanges:=False
                        Set wb = Workbooks.Add
                        On Error GoTo 0

                        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
                        .Range(.Cells(1, "A"), .Cells(total_Rows, lastColumn)).Copy _
                            Destination:=wb.Worksheets(1).Cells(1, 1)
                        Application.DisplayAlerts = False
                        wb.SaveAs Filename:=copy_Path & ws.Name, FileFormat:=xlOpenXMLWorkbook
                        wb.Close savechanges:=False
                        Application.DisplayAlerts = True
                End Select
            End With
        Next

    End With

End Sub