Excel – Get Handle on last worksheet copied by Worksheet.Copy

excelexcel-2003vba

I'm trying to get a handle to the worksheet that was created by a copy operation. following code used to work:

Dim wsTempl As Worksheet, pageCount as Long
Set wsTempl = Sheets("Template")
For pageCount = 1 To 5
   wsTempl.Copy After:=Sheets(Sheets.Count)
   Set ws = Sheets(Sheets.Count)
   ws.Name = "p" & pageCount 
Next

But stopped when adding VeryHidden worksheets to the workbook. now my Sheets(Sheets.Count) is getting the VeryHidden sheet instead of the sheet I added last.

Of course I could use

Set ws = Sheets(wsTempl.Name & " (2)")
ws.Name = "p" & pageCount

But that seems so ugly, is this really the only way? Can somebody think of another way?

to replicate the issue:

Open a New workbook, Name the first Sheet 'Template' & delete the other sheets
alt-f11 – insert code module & paste the above code
F5 should show you that it works.
insert a worksheet, using the worksheet tabs drag it to the end of collection
set it to VeryHidden in VBA IDE
F5 again, the first code listing should fail

Reason seems to be that the Copy After:= does not copy after VeryHidden Sheets, thus the part of the code to rename the sheet always renames the VeryHidden Sheet

Best Answer

The Copy method of a worksheet makes the newly created sheet active so you should be able to do this.


Dim wsTempl As Worksheet, i as int
Set wsTempl = Sheets("Template")
For i = 1 To 5
   wsTempl.Copy After:=Sheets(Sheets.Count)
   Set ws = ThisWorkbook.ActiveSheet
   ws.Name = "p" & pageCount 
Next

Related Solutions

Excel – How to capture worksheet being added through Copy/Paste in Excel VBA

When a sheet is copied, its name will always end with "(2)", or at least ")". You could check on that like this

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name Like "*(2)" Then
        Application.DisplayAlerts = False
        Sh.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Excel Macro: How to copy all rows from 3 worksheets and merge rows that are unique in the first column

Here's one way.

Option Explicit

Sub Test()
    Dim sheetNames: sheetNames = Array("Sheet1", "Sheet2", "Sheet3")
    Dim target As Worksheet: Set target = Worksheets("Sheet4")
    Dim accounts As New Dictionary
    Dim balances As New Dictionary
    Dim source As Range
    Dim row As Range
    Dim id As String
    Dim account As String
    Dim balance As Double
    Dim sheetName: For Each sheetName In sheetNames
        Set source = Worksheets(sheetName).Range("A1").CurrentRegion
        Set source = source.Offset(1, 0).Resize(source.Rows.Count - 1, source.Columns.Count)
        For Each row In source.Rows
            id = row.Cells(1).Value
            account = row.Cells(2).Value
            balance = row.Cells(3).Value
            accounts(id) = account
            If balances.Exists(id) Then
                balances(id) = balances(id) + balance
            Else
                balances(id) = balance
            End If
        Next row
    Next sheetName

    Call target.Range("A2:A65536").EntireRow.Delete

    Dim rowIndex As Long: rowIndex = 1
    Dim key
    For Each key In accounts.Keys
        rowIndex = rowIndex + 1
        target.Cells(rowIndex, 1).Value = key
        target.Cells(rowIndex, 2).Value = accounts(key)
        target.Cells(rowIndex, 3).Value = balances(key)
    Next key
End Sub

Create a new module (VBA editor -> Insert -> Module) and paste the above code into it.
Add a reference to Microsoft Scripting Runtime (VBA editor -> Tools -> References -> Check 'Microsoft Scripting Runtime').
Run it by placing the cursor within the code and pressing F5.

Obviously the sheets will have to be named Sheet1, Sheet2, Sheet3 and Sheet4. It won't paste the column headers into Sheet4 but presumably they are static so you can just set them up yourself beforehand.

Related Topic

Excel VBA WorkSheet.Copy After Excel 2013