VBA for duplicating slide and changing name based on table

[Legil]

Hi Everyone!

This is my first post and I just have one question

Let's say that we have two separate sheets, the first one, witha table of information for each teammate, like this one

ID	Name	Last Name
1	A	D
2	B	E
3	C	E

And another sheet (let's call it "List" the one we want to copy N times for each of the teammates)

How can we use a VBA formula so that when I press a button, it copies the "List" tab and it renames it to the ID that each teammate has?

For example: the result for this scenario would be generating three new sheets, all of them copies of the "List" one, but these three new ones would have the names "1", "2" and "3" respectively

Thanks a lot in advance for this

 

[bferraz]

Hey, please try the following code:

Sub CreateSheetsFromTable()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim row As Long
    Dim lastRow As Long
    Dim id As Long
    Dim name As String

    Set ws = ThisWorkbook.Sheets("Sheet1") ' change to the name of your first sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' get the last row with data in column A

    For row = 2 To lastRow ' loop through the rows, starting from the second row (assuming the first row is the header)
        id = ws.Cells(row, "A").Value ' get the ID
        name = ws.Cells(row, "B").Value & " " & ws.Cells(row, "C").Value ' get the name and last name

        Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ' add a new sheet at the end of the workbook
        newWs.Name = CStr(id) ' rename the new sheet with the ID
        ThisWorkbook.Sheets("List").Copy Before:=newWs ' copy the "List" sheet before the new sheet
    Next row
End Sub

 

[Legil]

Hey, please try the following code:

Sub CreateSheetsFromTable()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim row As Long
    Dim lastRow As Long
    Dim id As Long
    Dim name As String

    Set ws = ThisWorkbook.Sheets("Sheet1") ' change to the name of your first sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' get the last row with data in column A

    For row = 2 To lastRow ' loop through the rows, starting from the second row (assuming the first row is the header)
        id = ws.Cells(row, "A").Value ' get the ID
        name = ws.Cells(row, "B").Value & " " & ws.Cells(row, "C").Value ' get the name and last name

        Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ' add a new sheet at the end of the workbook
        newWs.Name = CStr(id) ' rename the new sheet with the ID
        ThisWorkbook.Sheets("List").Copy Before:=newWs ' copy the "List" sheet before the new sheet
    Next row
End Sub

Hey! Thank you very much for this input! I just tried it and it works, the only thing is that for example, the original file has this structure

ID

List

And the desired result would be this one

ID

List

1 (First copy of "List tab")

2 (Second copy of "List tab")

3 (Third copy of "List tab")

With the code you replied with, I am getting this

ID

List

List (1)

1

List (2)

2

List (3)

3

How can this be corrected?

 

[bferraz]

I am sorry, can you try this new version?

Sub CreateSheetsFromTable()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim row As Long
    Dim lastRow As Long
    Dim id As Long
    Dim name As String

    Set ws = ThisWorkbook.Sheets("List") ' change to the name of your first sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row ' get the last row with data in column A

    For row = 2 To lastRow ' loop through the rows, starting from the second row (assuming the first row is the header)
        id = ws.Cells(row, "A").Value ' get the ID
        name = ws.Cells(row, "B").Value & " " & ws.Cells(row, "C").Value ' get the name and last name
        With ThisWorkbook
        .Sheets("List").Copy After:=.Sheets(.Sheets.Count)
        End With
        Set newWs = ThisWorkbook.ActiveSheet
        newWs.name = CStr(id) ' rename the new sheet with the ID
    Next row
End Sub

 

[shinigamilight]

Sub op()
            Dim wk1, wk2 As Worksheet
            Set wk1 = Sheets("ID") 'change sheet
            Set wk2 = Sheets("List") 'change sheet
            Dim k As Integer
            Dim lr As Long
          
            lr = wk1.Range("A" & Rows.Count).End(xlUp).Row
          
            For k = 2 To lr
                    wk2.Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = k - 1
            Next k
          
          

End Sub

 

[Legil]

Thank you so much for both of you! your answers helped me structure the code and now its working with the functionality I was looking for

Thanks a lot for the input1

 

[bferraz]

You are welcome!