VBA code to Rename tables on duplicated sheet with sheet name appended

[TheMacroNoob]

Hello excel experts,

I have a VBA code via the magic of ChatGPT:

Sub DuplicateTemplateSheet()
Dim templateSheet As Worksheet
Dim newSheet As Worksheet
Dim sheetList As Worksheet
Dim sheetName As String
Dim lastRow As Long
Dim i As Long
Dim tbl As ListObject

' Set a reference to the Template sheet
Set templateSheet = ThisWorkbook.Sheets("Template")

' Set a reference to the SheetList sheet
Set sheetList = ThisWorkbook.Sheets("SheetList")

' Find the last row of the SheetList sheet
lastRow = sheetList.Cells(sheetList.Rows.Count, "B").End(xlUp).Row

' Loop through the list of sheet names in column B of the SheetList sheet
For i = 2 To lastRow
sheetName = sheetList.Cells(i, "B").Value

' Duplicate the Template sheet and rename the copy with the current sheet name
templateSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
newSheet.Name = sheetName

' Loop through all of the tables on the new sheet
For Each tbl In newSheet.ListObjects
  ' Rename the current table to include the sheet name
  tbl.Name = tbl.Name & "_" & sheetName
Next tbl

Next i

End Sub

There is one problem. The last directive to rename the tables doesn't really work as intended. For example, one of the tables on the 'Template' sheet is "Invoices_Paid". I would expect the duplicated sheet, correctly named "Berry", would have the new table name "Invoices_Paid_Berry", but instead, it is named "Invoices_Paid217_Berry". Numbers are added when you duplicate a table, so I'm wondering how to get around this. Is there a way to store the original table names from "Template" sheet, and then rename based on those values? Or something even easier?

I appreciate any help you can offer.

 

[Jeffrey Mahoney]

Please try this

Sub DuplicateTemplateSheet()
  Dim templateSheet As Worksheet
  Dim newSheet As Worksheet
  Dim sheetList As Worksheet
  Dim sheetName As String
  Dim lastRow As Long
  Dim i As Long
  Dim tbl As ListObject
  Dim TblName As String
  Dim X As Long
  Dim Nums As String
  Dim Str As String
  
  Nums = "0123456789"
  
  ' Set a reference to the Template sheet
  Set templateSheet = ThisWorkbook.Sheets("Template")

  ' Set a reference to the SheetList sheet
  Set sheetList = ThisWorkbook.Sheets("SheetList")

  ' Find the last row of the SheetList sheet
  lastRow = sheetList.Cells(sheetList.Rows.Count, "B").End(xlUp).Row

  ' Loop through the list of sheet names in column B of the SheetList sheet
  For i = 2 To lastRow
    sheetName = sheetList.Cells(i, "B").Value

    ' Duplicate the Template sheet and rename the copy with the current sheet name
    templateSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    newSheet.Name = sheetName
    
    ' Loop through all of the tables on the new sheet
    For Each tbl In newSheet.ListObjects
      ' Rename the current table to include the sheet name
      TblName = tbl.Name
      For X = Len(TblName) To 1 Step -1
        Str = Mid(TblName, X, 1)
        If InStr(Nums, Str) > 0 Then
          TblName = Left(TblName, X - 1)
        Else
          Exit For
        End If
      Next X
          
      tbl.Name = TblName & "_" & sheetName
    Next tbl
  
  Next i


End Sub

 

[TheMacroNoob]

Please try this

Sub DuplicateTemplateSheet()
  Dim templateSheet As Worksheet
  Dim newSheet As Worksheet
  Dim sheetList As Worksheet
  Dim sheetName As String
  Dim lastRow As Long
  Dim i As Long
  Dim tbl As ListObject
  Dim TblName As String
  Dim X As Long
  Dim Nums As String
  Dim Str As String
 
  Nums = "0123456789"
 
  ' Set a reference to the Template sheet
  Set templateSheet = ThisWorkbook.Sheets("Template")

  ' Set a reference to the SheetList sheet
  Set sheetList = ThisWorkbook.Sheets("SheetList")

  ' Find the last row of the SheetList sheet
  lastRow = sheetList.Cells(sheetList.Rows.Count, "B").End(xlUp).Row

  ' Loop through the list of sheet names in column B of the SheetList sheet
  For i = 2 To lastRow
    sheetName = sheetList.Cells(i, "B").Value

    ' Duplicate the Template sheet and rename the copy with the current sheet name
    templateSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    newSheet.Name = sheetName
   
    ' Loop through all of the tables on the new sheet
    For Each tbl In newSheet.ListObjects
      ' Rename the current table to include the sheet name
      TblName = tbl.Name
      For X = Len(TblName) To 1 Step -1
        Str = Mid(TblName, X, 1)
        If InStr(Nums, Str) > 0 Then
          TblName = Left(TblName, X - 1)
        Else
          Exit For
        End If
      Next X
         
      tbl.Name = TblName & "_" & sheetName
    Next tbl
 
  Next i


End Sub

That appears to have worked beautifully. Thank you very much! Amazing!