Copy sheet and get resulting sheet object?

后端 未结 13 1987
醉梦人生
醉梦人生 2020-11-28 12:21

Is there any easy/short way to get the worksheet object of the new sheet you get when you copy a worksheet?

ActiveWorkbook.Sheets(\         


        
相关标签:
13条回答
  • 2020-11-28 12:54

    It is correct that hidden worksheets cause the new worksheet index to be non-sequential on either side of the source worksheet. I found that Rachel's answer works if you're copying before. But you'd have to adjust it if you're copying after.

    Once the model is visible and copied, the new worksheet object is simply the ActiveSheet whether you copy the source before or after.

    As a preference, you could replace:

    Set newSheet = .Previous with Set newSheet = Application.ActiveSheet.

    Hope this is helpful to some of you.

    0 讨论(0)
  • 2020-11-28 12:56

    UPDATE:

    Dim ThisSheet As Worksheet
    Dim NewSheet As Worksheet
    Set ThisSheet = ActiveWorkbook.Sheets("Sheet1")
    ThisSheet.Copy
    Set NewSheet = Application.ActiveSheet
    
    0 讨论(0)
  • 2020-11-28 13:07
    Dim sht 
    
    With ActiveWorkbook
       .Sheets("Sheet1").Copy After:= .Sheets("Sheet2")
       Set sht = .Sheets(.Sheets("Sheet2").Index + 1)
    End With
    
    0 讨论(0)
  • 2020-11-28 13:09

    Old post but wasn't sure about unhiding sheets or adding suffixes to names.

    This is my approach:

    Sub DuplicateSheet()
        Dim position As Integer
        Dim wbNewSheet As Worksheet
        position = GetFirstVisiblePostion
    
        ThisWorkbook.Worksheets("Original").Copy Before:=ThisWorkbook.Sheets(position)
        Set wbNewSheet = ThisWorkbook.Sheets(position)
    
        Debug.Print "Duplicated name:" & wbNewSheet.Name, "Duplicated position:" & wbNewSheet.Index
    
    End Sub
    
    Function GetFirstVisiblePostion() As Integer
        Dim wbSheet As Worksheet
        Dim position As Integer
        For Each wbSheet In ThisWorkbook.Sheets
            If wbSheet.Visible = xlSheetVisible Then
                position = wbSheet.Index
                Exit For
            End If
        Next
        GetFirstVisiblePostion = position
    End Function
    
    0 讨论(0)
  • 2020-11-28 13:11

    I believe I have finally nailed this issue - it's been driving me nuts, also! It really would have been nice if MS made Copy return a sheet object, same as the Add method...

    The thing is, the index which VBA allocates a newly copied sheet is actually not determined... as others have noted, it very much depends on hidden sheets. In fact, I think the expression Sheets(n) is actually interpreted as "the nth visible sheet". So unless you write a loop testing every sheet's visible property, using this in code is fraught with danger, unless the workbook is protected so users cannot mess with sheets visible property. Too hard...

    My solution to this dilemma is:

    1. Make the LAST sheet visible (even if temporary)
    2. Copy AFTER that sheet. It MUST have index Sheets.Count
    3. Hide the former last sheet again, if required - it will now have index Sheets.Count-1
    4. Move the new sheet to where you really want it.

    Here's my code - which now seems to be bullet-proof...

    Dim sh as worksheet
    Dim last_is_visible as boolean
    
    With ActiveWorkbook
        last_is_visible = .Sheets(.Sheets.Count).Visible
        .Sheets(Sheets.Count).Visible = True
        .Sheets("Template").Copy After:=.Sheets(Sheets.Count)
        Set sh=.Sheets(Sheets.Count)
        if not last_is_visible then .Sheets(Sheets.Count-1).Visible = False 
        sh.Move After:=.Sheets("OtherSheet")
    End With
    

    In my case, I had something like this (H indicating a hidden sheet)

    1... 2... 3(H)... 4(H)... 5(H)... 6... 7... 8(H)... 9(H)

    .Copy After:=.Sheets(2) actually creates a new sheet BEFORE the next VISIBLE sheet - ie, it became the new index 6. NOT at index 3, as you might expect.

    Hope that helps ;-)

    0 讨论(0)
  • 2020-11-28 13:12

    I realise this post is over a year old, but I came here looking for an answer to the same issue regarding copying sheets and unexpected results caused by hidden sheets. None of the above really suited what I wanted mainly because of the structure of my workbook. Essentailly it has a very large number of sheets and what is displayed is driven by a user selecting the specific functionality, plus the order of the visible sheets was importnat to me so i didnt want to mess with those. So my end solution was to rely on Excels default naming convention for copied sheets, and explictly rename the new sheet by name. Code sample below (as an aside, my workbook has 42 sheets and only 7 are permanently visible, and the after:=Sheets(Sheets.count) put my copied sheet in the middle of the 42 sheets, depending on what sheets are visible at the time.

            Select Case DCSType
            Case "Radiology"
                'Copy the appropriate Template to a new sheet at the end
                TemplateRAD.Copy after:=Sheets(Sheets.count)
                wsToCopyName = TemplateRAD.Name & " (2)"
                'rename it as "Template"
                Sheets(wsToCopyName).Name = "Template"
                'Copy the appropriate val_Request to a new sheet at the end
                valRequestRad.Copy after:=Sheets(Sheets.count)
                'rename it as "val_Request"
                wsToCopyName = valRequestRad.Name & " (2)"
                Sheets(wsToCopyName).Name = "val_Request"
            Case "Pathology"
                'Copy the appropriate Template to a new sheet at the end
                TemplatePath.Copy after:=Sheets(Sheets.count)
                wsToCopyName = TemplatePath.Name & " (2)"
                'rename it as "Template"
                Sheets(wsToCopyName).Name = "Template"
                'Copy the appropriate val_Request to a new sheet at the end
                valRequestPath.Copy after:=Sheets(Sheets.count)
                wsToCopyName = valRequestPath.Name & " (2)"
                'rename it as "val_Request"
                Sheets(wsToCopyName).Name = "val_Request"
        End Select
    

    Anyway, posted just in case its useful to anyone else

    0 讨论(0)
提交回复
热议问题