如何修复 - Excel VBA 复制和粘贴值 - 此工作簿错误

Question

>我正在为我的财务模型设置复制/粘贴宏。

虽然它目前运行良好，但如果我保存模型的新版本，我就无法制作。该模型具有我需要粘贴的基本选项卡，以及几个对切换进行操作并循环浏览 10-15 张工作表的选项卡，因此我在代码中粘贴了一个工作表和一个循环的示例。

Copy_PasteWorkbook.xlsm 是一个空白的 Excel 文档，用作粘贴的位置。

现在，只有当我定义其运行的文件的名称并且我无法让工作簿(ThisWorkbook(在代码中工作时，它才会起作用。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Windows("Copy_PasteWorkbook.xlsx").Activate
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Model"
Windows("XYZ_v1.xlsm").Activate
Sheets("Value_Summary_Sheet").Select
Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Copy
Windows("Copy_PasteWorkbook.xlsx").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=8
Sheets("Model").Select
Sheets("Model").Name = Cells(1, 3).Value
Range("A1").Select
Application.CutCopyMode = False
Windows("XYZ_v1.xlsm").Activate
Range("A1").Select
Sheets("Inputs").Range("Selected_Toggle_Number").Value = 1
Do Until Sheets("Inputs").Range("Selected_Toggle_Number").Value > Sheets("Inputs").Range("Total_Toggles").Value
Application.Calculate
Windows("Copy_PasteWorkbook.xlsx").Activate
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Model"
Windows("XYZ_v1.xlsm").Activate
Sheets("Financial Models").Select
Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Copy
Windows("Copy_PasteWorkbook.xlsx").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=8
Sheets("Model").Select
Sheets("Model").Name = Cells(1, 3).Value
Range("A1").Select
Application.CutCopyMode = False
Windows("XYZ_v1.xlsm").Activate
Range("A1").Select
Sheets("Inputs").Range("Selected_Toggle_Number").Value = Sheets("Inputs").Range("Selected_Toggle_Number").Value + 1
DoEvents
Loop
Sheets("Inputs").Range("Selected_Toggle_Number").Value = 1
Sheets("Inputs").Select
Range("A1").Select
Application.CommandBars("Clipboard").Visible = True
On Error Resume Next 'incase clipboard IS empty
Application.CommandBars("Clipboard").FindControl(ID:=3634).Execute
Application.CommandBars("Clipboard").Visible = False
Application.ScreenUpdating = True
End Sub

---

理想情况下，我想订阅Windows("XYZ_V1.xlsm"(。使用此工作簿激活代码，以便每当对模型进行更改时，它都可以运行。现在，如果我更新并保存新版本，则必须为新名称更新整个代码。

Answer 1

这个答案花了我一段时间，但由于你是新手，我认为最好向您展示代码是如何以及在何处更改的。

删除所有注释后，代码会更短：

Sub Test()
    Dim wb As Workbook, wbPaste As Workbook, wsSumary As Worksheet, wsPaste As Worksheet, wsInputs As Worksheet, _
    wsFinMod As Worksheet
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    'First you need to avoid using select, in that matter you need worksheet and workbook variables
    Set wb = ThisWorkbook 'the workbook containing the code
    Set wbPaste = Workbooks("Copy_PasteWorkbook.xlsx") 'the workbook where you are going to paste
    With wb
        Set wsSumary = .Sheets("Value_Summary_Sheet")
        Set wsInputs = .Sheets("Inputs")
        Set wsFinMod = .Sheets("Financial Models")
    End With
    'The code above sets your worksheets and workbooks on the macro file
    With wbPaste
        Set wsPaste = .Sheets.Add(after:=.Sheets(.Sheets.Count))
    End With
    'the code above sets the paste workbook, adds a sheet and names it "Model", also equals to this:
'        Windows("Copy_PasteWorkbook.xlsx").Activate
'        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
'        ActiveSheet.Name = "Model"
    With wsPaste
        wsSumary.UsedRange.Copy
        .Range("A1").PasteSpecial xlPasteValues '?¿?¿ I assume from your code you want to paste it there
        .Range("A1").PasteSpecial xlPasteFormats
        .Name = .Cells(1, 3)
    End With
    'The code above equals to this:
'        Windows("XYZ_v1.xlsm").Activate
'        Sheets("Value_Summary_Sheet").Select
'        Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Select
'        Selection.Copy
'        Windows("Copy_PasteWorkbook.xlsx").Activate
'        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'            :=False, Transpose:=False
'        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
'            SkipBlanks:=False, Transpose:=False
'        Selection.PasteSpecial Paste:=8
'        Sheets("Model").Select
'        Sheets("Model").Name = Cells(1, 3).Value
'        Range("A1").Select
'        Application.CutCopyMode = False
    Dim i As Long, x As Long, wsTemp As Worksheet
    x = wsInputs.Range("Total_Toggles").Value
    For i = 1 To x
        Application.Calculate
        With wbPaste
            Set wsTemp = .Sheets.Add(after:=.Sheets(.Sheets.Count))
        End With
        With wsTemp
            wsFinMod.UsedRange.Copy
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
            .Name = .Cells(1, 3)
        End With
    Next i
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .CutCopyMode = False
    End With
    'The code above equals to this:
'        Windows("XYZ_v1.xlsm").Activate
'        Range("A1").Select
'        Sheets("Inputs").Range("Selected_Toggle_Number").Value = 1
'        Do Until Sheets("Inputs").Range("Selected_Toggle_Number").Value > Sheets("Inputs").Range("Total_Toggles").Value
'            Application.Calculate
'            Windows("Copy_PasteWorkbook.xlsx").Activate
'            ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
'            ActiveSheet.Name = "Model"
'            Windows("XYZ_v1.xlsm").Activate
'            Sheets("Financial Models").Select
'            Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Select
'            Selection.Copy
'            Windows("Copy_PasteWorkbook.xlsx").Activate
'            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'                :=False, Transpose:=False
'            Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
'                SkipBlanks:=False, Transpose:=False
'            Selection.PasteSpecial Paste:=8
'            Sheets("Model").Select
'            Sheets("Model").Name = Cells(1, 3).Value
'            Range("A1").Select
'            Application.CutCopyMode = False
'            Windows("XYZ_v1.xlsm").Activate
'            Range("A1").Select
'            Sheets("Inputs").Range("Selected_Toggle_Number").Value = Sheets("Inputs").Range("Selected_Toggle_Number").Value + 1
'            DoEvents
'        Loop
'
'        Sheets("Inputs").Range("Selected_Toggle_Number").Value = 1
'        Sheets("Inputs").Select
'        Range("A1").Select
'        Application.CommandBars("Clipboard").Visible = True
'        On Error Resume Next 'incase clipboard IS empty
'        Application.CommandBars("Clipboard").FindControl(ID:=3634).Execute
'        Application.CommandBars("Clipboard").Visible = False
'        Application.ScreenUpdating = True
End Sub

您的代码如下所示：

Sub Test()
    Dim wb As Workbook, wbPaste As Workbook, wsSumary As Worksheet, wsPaste As Worksheet, wsInputs As Worksheet, _
    wsFinMod As Worksheet
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    'First you need to avoid using select, in that matter you need worksheet and workbook variables
    Set wb = ThisWorkbook 'the workbook containing the code
    Set wbPaste = Workbooks("Copy_PasteWorkbook.xlsx") 'the workbook where you are going to paste
    With wb
        Set wsSumary = .Sheets("Value_Summary_Sheet")
        Set wsInputs = .Sheets("Inputs")
        Set wsFinMod = .Sheets("Financial Models")
    End With
    With wbPaste
        Set wsPaste = .Sheets.Add(after:=.Sheets(.Sheets.Count))
    End With
    With wsPaste
        wsSumary.UsedRange.Copy
        .Range("A1").PasteSpecial xlPasteValues '?¿?¿ I assume from your code you want to paste it there
        .Range("A1").PasteSpecial xlPasteFormats
        .Name = .Cells(1, 3)
    End With
    Dim i As Long, x As Long, wsTemp As Worksheet
    x = wsInputs.Range("Total_Toggles").Value
    For i = 1 To x
        Application.Calculate
        With wbPaste
            Set wsTemp = .Sheets.Add(after:=.Sheets(.Sheets.Count))
        End With
        With wsTemp
            wsFinMod.UsedRange.Copy
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
            .Name = .Cells(1, 3)
        End With
    Next i
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .CutCopyMode = False
    End With
End Sub

Answer 2

这是如何重写代码第一部分的示例。这不是一个完整的答案，但可以帮助您理解和重写代码。您不需要所有Activate或Select，您可以进行Google搜索以了解如何避免它们

Dim Destwb As Workbook, Srcewb As Workbook
Set Destwb = Workbooks("Copy_PasteWorkbook")
Set Srcewb = Workbooks("XYZ_v1") 'or "ThisWorkbook" if the source wb is the wb with your macro
    Destwb.Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Model" 'add a new worksheet and rename it
    'copy the range from the source workbook
    Srcewb.Sheets("Value_Summary_Sheet").Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Copy
    'paste the copied range to the new worksheet in the destination workbook
    Destwb.Sheets("Model").Cells(1, 1).PasteSpecial Paste:=xlPasteValues 'all other paramaters are optional
    'change the name of the new worksheet again(you could have set the name to the cell value the first time
    Destwb.Sheets("Model").Name = Cells(1, 3).Value
    'Goto a specific cell in the scource workbook
    Application.Goto Srcewb.Range("A1"), Scroll = True