How to automate this Macro?

[titoexcel]

Hello!

I am trying to write a macro to populate a template from a sheet called top 25. I am having a bit trouble finding a way to automate this in a sense that after the macro populates the template from row 2, i would want it to copy that template it just filled out and put it as a new sheet and go on to the row 3 and populate it and so on..

I have 261 records, please let me know if this is doable?

Thank you and here is my macro below.

Sub InputDataintotemplate()
'
' InputDataintotemplate Macro
'
' Keyboard Shortcut: Ctrl+i
'
Range("B6").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-4]C[-1]"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B12").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-10]C[4]"
Range("B14").Select
Sheets("TOP 25").Select
Columns("F:O").Select
Selection.EntireColumn.Hidden = False
Range("F14").Select
Sheets("QF000542").Select
Range("B14").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-12]C[8]"
Range("B20").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-18]C[4]"
Range("D12").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-10]C[11]"
Range("D13").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-11]C[12]"
Range("D15").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-13]C[14]"
Range("D16").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-14]C[15]"
Range("D17").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-15]C[16]"
Range("D18").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-16]C[17]"
Range("D20").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-18]C[5]"
Range("D21").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-19]C[1]"
Range("D22").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-20]C[-2]"
Range("D23").Select
Rows("23:23").RowHeight = 25.5
Range("D28").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-26]C[18]"
Range("D29").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-27]C[19]"
Range("B34").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-32]C[23]"
Range("B35").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-33]C[24]"
Range("B37").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-35]C[26]"
Range("B38").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-36]C[27]"
Range("B39").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-37]C[28]"
Range("B40").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-38]C[29]"
Range("B41").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-39]C[30]"
Range("B42").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-40]C[31]"
Range("B43").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-41]C[32]"
Range("D30").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-28]C[20]"
Range("D34").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-32]C[31]"
Range("D35").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-33]C[32]"
Range("D37").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-35]C[34]"
Range("D38").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-36]C[35]"
Range("D39").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-37]C[36]"
Range("D40").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-38]C[37]"
Range("D41").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-39]C[38]"
Range("D42").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-40]C[39]"
Range("D43").Select
ActiveCell.FormulaR1C1 = "='TOP 25'!R[-41]C[40]"
Range("C44:D45").Select
ActiveWindow.SmallScroll Down:=-9
End Sub

 

[patel45]

please upload a sample file (with current data and desired result) on a sharing site, then paste the link here