保存后 - 在新工作簿中创建 2 张不带公式的副本并另存为

Question

我有一个很大的 Excel 文件 (ORIGINAL.xlsm)，其中有很多页。当我保存 ORIGINAL.xlsm 时，我需要自动创建另一个文件 (COPY.xlsx)。 COPY.xlsx 文件应该只包含 2 个工作表（EXP1 和 EXP2）。 但是 EXP1 和 EXP2 只能包含没有公式的值，ORIGINAL.xlsm 可能不受此操作的影响。 我正在尝试解决，但原始文件总是受到负面影响（公式删除）。我想避免使用 ActiveWorkBook 调用，因为它经常使用多个打开 Excel.

    Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim UserProfile As String
Dim Path As String
Dim NewBook2 As Workbook
UserProfile = VBA.Environ$("Userprofile")

Path = UserProfile & "\Dropbox\Program\COPY.xlsx"


Set NewBook2 = Workbooks.Add
NewBook2.SaveAs Filename:=Path

ThisWorkbook.Sheets("EXP1").Copy Before:=Workbooks("COPY.xlsx").Sheets(1)
ThisWorkbook.Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)

Workbooks("COPY.xlsx").Sheets("EXP2").Activate
Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Select


Workbooks("COPY.xlsx").Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)

REM PROBLEM HERE
Workbooks("COPY.xlsx").UsedRange.Value = Workbooks("COPY.xlsx").UsedRange.Value

End Sub

Answer 1

您既不需要带有 .Activate 的行也不需要带有 .Select 的行来使此代码工作。你可能会从阅读中受益 How to avoid using Select in Excel VBA.

请注意，您的 Workbooks("COPY.xlsx") 已设置为 NewBook2，因此最好使用该变量，以防万一名称 COPY.xlsx 发生变化 NewBook2 将始终有效。

Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Dim UserProfile As String
    UserProfile = VBA.Environ$("Userprofile")

    Dim Path As String
    Path = UserProfile & "\Dropbox\Program\COPY.xlsx"
    
    Dim NewBook2 As Workbook
    Set NewBook2 = Workbooks.Add
    NewBook2.SaveAs Filename:=Path
    
    ThisWorkbook.Sheets("EXP1").Copy Before:=NewBook2.Sheets(1)
    ThisWorkbook.Sheets("EXP2").Copy Before:=NewBook2.Sheets(2)

    NewBook2.Sheets(2).UsedRange.Value = NewBook2.Sheets(2).UsedRange.Value

    'here you need to save and probably close your new workbook
    NewBook2.Close SaveChanges:=True 'or NewBook2.Save if you want to keep it open.
End Sub

您遇到的问题是工作簿没有像 Workbooks("COPY.xlsx").UsedRange 这样的 UsedRange 您需要指定像 NewBook2.Sheets(2).UsedRange.

这样的工作表

Answer 2

这对我有用...谢谢我不太相信 Excel 中的相对链接作为 ActiveWorkbook 或 NewBook2.Sheets(2) 出于这个原因，打开的文件名在我的代码中。事实证明，这最好适用于更开放的 Excel（对我而言）。

        Option Explicit
    Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Dim UserProfile As String
    UserProfile = VBA.Environ$("Userprofile")
    
    Dim path As String
    path = UserProfile & "\Dropbox\Program\COPY.xlsx"
    
    Dim NewBook2 As Workbook
    Set NewBook2 = Workbooks.Add
    NewBook2.SaveAs Filename:=path
    
    ThisWorkbook.Sheets("EXP1").Copy Before:=Workbooks("COPY.xlsx").Sheets(1)
    ThisWorkbook.Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)
    
    Workbooks("COPY.xlsx").Sheets("EXP2").Activate
    Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Select
    Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Value = Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Value
  
rem if file exists no alert display  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks("COPY.xlsx").SaveAs Filename:=path
    Workbooks("COPY.xlsx").Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    End Sub

保存后 - 在新工作簿中创建 2 张不带公式的副本并另存为

After save - Creating 2 sheets Copy without Formulas in New workbook and Save as

excel

vba

copy

worksheet