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

Question

I'm setting up a copy/paste macro for my financial model.

While it is currently running just fine, I am having trouble making if I save a new version of the model. The model has basic tabs I need to paste over as well as several tabs that operate on toggles and cycle through 10-15 sheets, so I have pasted an example of one sheet and one cycle in the code.

Copy_PasteWorkbook.xlsm is a blank excel document utilized as the location of the pasting.

Right now it will only work if I define the name of the file its running in and I cannot get Workbook(ThisWorkbook) to work in the code.

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

---

Ideally I would like to sub out the Windows("XYZ_V1.xlsm").Activate code with ThisWorkbook so that it can function whenever changes are made to the model. Right now if I update and save a new version I then have to update the code throughout for the new name.

Answer 1

This answer took me a while, but since you are new I thought it was better to show you how and where your code was changed.

Once you delete all the comments the code is way shorter:

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

This is how your code would look like:

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

This is an example of how to rewrite the first part of your code. It is not a total answer, but can help you understand and rewrite your code. You don't need all the Activate or Select , you can do a Google search on how to avoid them

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