vba - 尝试将一个工作表从一个工作簿复制到另一个预先存在的工作表中？

Question

我编写了以下代码，它会迭代主工作簿的工作表，检查条件，然后如果满足该条件，则会将事件工作表复制到新工作簿中并保存。但是，我只想将工作表附加到另一个笔记本。

Sub Archive_Sheets()

For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    Dim SrchRng As Range, cel As Range
    Set SrchRng = ws.Range("C9:C108")

    Dim bought_amt As Integer
    Dim called_amt As Integer

    bought_amt = 0
    called_amt = 0

    For Each cel In SrchRng
        If InStr(1, cel.Value, "BOUGHT") > 0 Then
            bought_amt = bought_amt + cel.Offset(0, 1).Value
        End If

        If InStr(1, cel.Value, "CALLED") > 0 Then
            called_amt = called_amt + cel.Offset(0, 1).Value
        End If

    Next cel

    If called_amt = bought_amt Then
        ws.Range("A1").Value = "DONE"

        Module8.CopySheet

        Exit For

        'ws.Delete
    End If
Next

End Sub


Sub CopySheet()

    Application.DisplayAlerts = False

    Dim wb_name_arr() As String

    pName = ActiveWorkbook.Path
    wbName = ActiveWorkbook.Name  ' the file name of the currently active file
    shtName = ActiveSheet.Name    ' the name of the currently selected worksheet
    wb_name_arr() = Split(wbName, ".")

    Application.ScreenUpdating = False
    ActiveSheet.Select
    ActiveSheet.Copy
    ' NEED TO CHANGE THIS LINE ********************
    ActiveSheet.SaveAs Filename:=pName + "\" + wb_name_arr(0) + " archived.xlsx"
    '****************************
    Application.ScreenUpdating = True

End Sub

上面的代码将覆盖我保存到的新工作簿，因此它只是最新的工作表。我已经创建了此工作簿，因此如果我可以将事件工作表附加到其中，那就太理想了。我已经尝试过了

ActiveSheet.Copy After:=Workbook(pName + "\" + wb_name_arr(0) + " archived.xlsx")

和

ActiveSheet.Copy Before:=Workbooks.Open(pName + "\" + wb_name_arr(0) + " archived.xlsx").Sheets(0)

运气不好。

Answer 1

这些行是伪代码。总体思路是隐式无。尝试明确引用工作簿和工作表，而不是激活它们。这也更快。

尽量避免在代码中使用ActiveSheet。只需尝试这样的事情:

Set mySht = ActiveSheet 'This should be set at the beginning of your code

然后，每当您的代码中有该工作表(即 ActiveSheet)时，请改用 oSht。

因此，您需要打开工作簿才能对其进行操作。同样，您可以为不同的工作簿分配一个名称，如下所示:

Set myWbk = ActiveWorkbook
'Or
Set oWbk = Workbooks("Output.xlsx")

@A.S.H 提出的建议对你来说是这样的:

oFile = "Path/to/the/File/" & wb_name_arr(0) & " archived.xlsx"
Set oWbk = Workbooks.Open(oFile)
mySht.Copy Before:=Workbooks(oWbk).sheets(1)