Copy sheet by codename and rename

0
votes

I'm trying to copy a sheet by its code name and rename the copied sheets display name and code name,

I've come up with this but it only work one time and then it gets an error because there is already a sheet with that display name and codename, is there a why i can just add value + 1 to the end of the names?

Sub TESTONE()


Dim MySheetName As String
MySheetName = "Rename Me"
VBA_Copy_Sheet.Copy After:=ActiveSheet
ActiveSheet.Name = MySheetName

ActiveSheet.Tab.ColorIndex = 3

Dim wks As Worksheet
Set wks = ActiveSheet
ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = "BidSheet"


End Sub
2
vbaexcel
Nope, no reason. Just increment by 1 and append it to the string like you guessed, and you can loop through as many sheets as you want. – Tim
Before copy sheet why not detect sheets name ? Sub FnGetSheetsName() Dim mainworkBook As Workbook Set mainworkBook = ActiveWorkbook For i = 1 To mainworkBook.Sheets.count ‘Either we can put all names in an array , here we are printing all the names in Sheet 2 mainworkBook.Sheets(“Sheet2”).Range(“A” & i) = mainworkBook.Sheets(i).Name Next i End Sub – Hugues Paquet Blanchette
@Tim Value + 1 will not work because it copies a sheet and then adds 1 to the end which works the first time but when you try to copy the sheet again its just adds 1 to the copied sheet making it the same name as the first copy. – luke
@luke That's why I said increment. value = value +1 ;) – Tim

2 Answers

0
votes

I wish, it helps to you

Sub TESTONE()

Dim MySheetName As String
Dim MyCodeName As String
Dim wks As Worksheet

MySheetName = "Rename Me"
MyCodeName = "BidSheet"

If VBA_Copy_Sheet = Empty Then
Set VBA_Copy_Sheet = ActiveSheet
End If

VBA_Copy_Sheet.Copy After:=ActiveSheet

ActiveSheet.Name = GetNewSheetName(MySheetName, 0)

ActiveSheet.Tab.ColorIndex = 3
Set wks = ActiveSheet
MyCodeName = GetNewCodeName(MyCodeName, 0)

ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = MyCodeName

End Sub

Function GetNewSheetName(ByVal newName As String, ByVal n As Integer) As String

    Dim ws As Worksheet
    Dim modifiedName As String
    modifiedName = newName & n

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = modifiedName Then
            n = n + 1
            modifiedName = GetNewSheetName(newName, n)
            Exit For
        End If
    Next
    GetNewSheetName = modifiedName
End Function

Function GetNewCodeName(ByVal newName As String, ByVal n As Integer) As String

    Dim ws As Worksheet
    Dim modifiedName As String
    modifiedName = newName & n

    For Each ws In ActiveWorkbook.Worksheets
        If ws.CodeName = modifiedName Then
            n = n + 1
            modifiedName = GetNewCodeName(newName, n)
            Exit For
        End If
    Next
    GetNewCodeName = modifiedName
End Function
0
votes

You could store a counter in a range name and use that to increment your sheet, i.e:

Dim strName As String
Dim strCnt As String
Dim MySheetName As String

strName = "SheetCnt"

On Error Resume Next
strCnt = ActiveWorkbook.Names(strName).Value
On Error GoTo 0
If Len(strCnt) = 0 Then
    ActiveWorkbook.Names.Add strName, 1
Else
    strCnt = Replace(strCnt, "=", Chr(32)) + 1
    ActiveWorkbook.Names(strName).RefersTo = strCnt
End If

MySheetName = "Rename Me " & strCnt