excel - 如何修复 - Excel VBA 复制和粘贴值 - ThisWorkbook 错误

Question

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

虽然它目前运行良好，但如果我保存模型的新版本，我会遇到麻烦。该模型具有我需要粘贴的基本选项卡以及几个在切换上操作并循环通过 10-15 个工作表的选项卡，因此我在代码中粘贴了一个工作表和一个循环的示例。

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

现在它只有在我定义它运行的文件的名称并且我无法让Workbook(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

---

理想情况下，我想使用 ThisWorkbook 替换 Windows("XYZ_V1.xlsm").Activate 代码，以便在对模型进行更改时它可以运行。现在，如果我更新并保存一个新版本，那么我必须为新名称更新整个代码。

标签： excelvba

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