[VBA] Duplicate sheets & update sheet name and two cells based on list

[bnbcat]

Hello,

I have the handy code below to duplicate a sheet multiple times and update the sheet name based on a list of values.

Sub CreateSheetsFromAList()
Dim Location As Range
Dim dic As Object, c As Range
Dim k As Variant, tmp As String

Set dic = CreateObject("scripting.dictionary")
Set Location = Sheets("Sheet3").Range("A1")
Set Location = Range(Location, Location.End(xlDown))

For Each c In Location
tmp = Trim(c.Value)
If Len(tmp) > 0 Then dic(tmp) = dic(tmp) + 1
Next c

For Each k In dic.keys
Sheets("COUNTRY").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = k ' renames the new worksheet


Next k


End Sub

I need to add to this so that not only are the sheet names updated, but values in 2 different locations are updated as well, also based on a list.

IE:

Value list:

Sheet Name	Cell A1	Cell A3
USA_Apple	USA	Apple
USA_Banana	USA	Banana
CA_Apple	Canada	Apple

So when the sheets are duplicated, the first sheet will be titled "USA_Apple" with cell A1 containing "USA" and cell A3 containing "Apple", the second sheet titled "USA_Banana" with cell A1 containing "USA" and cell A3 containing "Banana," and the third sheet titled "CA_Apple" with cell A1 containing "Canada" and cell A3 containing "Apple."

All help would be very appreciated!!

 

[Fluff]

Can you have duplicate values in col A?