VBA to duplicate sheet and enter data based on list

[mountainman88]

I have a tab called ‘list’ and and a tab called ‘template’.

on the ‘list’ tab there can be any number of unique items in Column A with a paired item in Column B.

I need some VBA that will copy the ‘template’ tab and rename it to each item in Column A from ‘list’ and then in cell C3 of the ‘template’ tab enter the corresponding text that is in Column B of the ‘list’ tab. This should loop until there are as many new renamed template tabs as there are items on the ‘list’ tab.

Eg. If ‘list’ A1 / B1 was Duck / Quack

the ‘template’ tab would be copied and renamed ‘Duck’ and ‘Quack’ would be input into cell C3 on the ‘Duck’ tab.

This would need to loop and be repeated for every row that has another pair of items on the ‘list’ tab.

thanks!

 

[Osvaldo Palmeiro]

Try this code, please.

Sub DuplicateSheet()
 Dim c As Range
  Application.ScreenUpdating = False
  For Each c In Sheets("list").Range("A2:A" & Sheets("list").Cells(Rows.Count, 1).End(3).Row)
   If Application.CountA(c.Resize(, 2)) = 2 Then
    Sheets("template").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = c.Value: [C3] = c.Offset(, 1).Value
   End If
  Next c
End Sub

 

[mountainman88]

So I had to tweak the code fo rmy sheet as follows:

Sub DuplicateSheet()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("lists").Range("d5:d" & Sheets("lists").Cells(Rows.Count, 1).End(3).Row)
If Application.CountA(c.Resize(, 2)) = 2 Then
Sheets("template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: [d4] = c.Offset(, -2).Value
End If
Next c
End Sub

The list of tab names on the 'lists' tab is a range starting at D5 and the corresponding 'template' cell entry is in B5 (now being entered into cell D4 on each template copied)

The first issue is it is starting the list before row 5, and creating a random tab with the column headings form the 'lists' sheet.

It creates this tab with the headings, then it creates the first line in 'lists' just fine, then it stops after creating those 2 tabs.

Thanks for your help!

 

[Osvaldo Palmeiro]

Then try the retweaked code below.

Sub DuplicateSheetV2()
 Dim c As Range
  Application.ScreenUpdating = False
  For Each c In Sheets("lists").Range("D5:D" & Sheets("lists").Cells(Rows.Count, 4).End(3).Row)
   Sheets("template").Copy After:=Sheets(Sheets.Count)
   ActiveSheet.Name = c.Value: [D4] = c.Offset(, -2).Value
  Next c
End Sub