Copy values of a list one by one to multiple worksheets

[amir2552]

I have an "Input" spreadsheet with a list of unique values. Then I have a series of worksheets that are identical templates. I want to paste each unique value from the list on the "Input" sheet into the same cell within each of the separate worksheet templates. Is there a Marco / VBA code that could automate this for me?
An example is below:

"Input" Sheet:
Template Serial No.
1 755888
2 726958
3 745236
4 845694
5 788956

In the Worksheet currently named "1", I want Serial No. "755888" pasted in Cell "C3". And if possible the worksheet renamed to "755888"
In the Worksheet currently named "2", I want Serial No. "726958" pasted in Cell "C3". And if possible the worksheet renamed to "726958"
In the Worksheet currently named "3", I want Serial No. "745236" pasted in Cell "C3". And if possible the worksheet renamed to "745236"
.....and so on.... through the entire list of values in the "Input" sheet. The cell I want the value pasted in for each worksheet will be fixed and the same for each worksheet.

Thank you,

 

[Francoise]

Assuming that the "Input" sheet and the sheets 1,2,3, ...etc. exist and are in the same file, you can use this code:

Sub macro1()
Dim x as Integer
With Sheets("Input")
x = 1
Do Until IsEmpty(.Range("a" & x))
.Range("a" & x).Copy Sheets(x).Range("c3")
Sheets(x).Name = .Range("a" & x).Value
x = x + 1
Loop
End With
End Sub

 

[amir2552]

Assuming that the "Input" sheet and the sheets 1,2,3, ...etc. exist and are in the same file, you can use this code:

Sub macro1()
Dim x as Integer
With Sheets("Input")
x = 1
Do Until IsEmpty(.Range("a" & x))
.Range("a" & x).Copy Sheets(x).Range("c3")
Sheets(x).Name = .Range("a" & x).Value
x = x + 1
Loop
End With
End Sub

Thank you Francoise,

Can you update the code if the sheets' names are letters (not 1, 2, 3)?

 

[Francoise]

If the sheet "Input" is the first sheet, make sure that the following sheets are sheets 2, 3, 4, etc. (sheet numbers, not sheet names). If so, you can use this macro:

Sub macro1()
Dim x As Integer
With Sheets("Input")
x = 1
Do Until IsEmpty(.Range("a" & x))
.Range("a" & x).Copy Sheets(x + 1).Range("c3")
Sheets(x + 1).Name = .Range("a" & x).Value
x = x + 1
Loop
End With
End Sub