Copy Formula Down In Dynamic Range

Question

I am pasting a formula in a cell with a macro and need to copy that formula and paste all the way down but my code is not working

The problems lies in the last 7 lines of code.  I want to copy the formula from the cell, that is no problem.  Then I want to paste that formula all the way down.  If you see any other ways to clean up my code don't be bashful, I love constructive criticism.

Sub feeder()

Dim ActNm As String

With ActiveWorkbook.Sheets

Sheets("HelpTemplate").Visible = True

Sheets("HelpTemplate").Select

Sheets("HelpTemplate").Copy after:=Worksheets(Worksheets.Count)

Sheets("HelpTemplate").Visible = False

End With

ActNm = ActiveSheet.Name

On Error Resume Next

ActiveSheet.Name = "Template"

NoName: If Err.Number = 1004 Then ActiveSheet.Name = InputBox("Please Name New System.")

If ActiveSheet.Name = ActNm Then GoTo NoName

On Error GoTo 0

Dim current As String

current = ActiveSheet.Name

Sheets("Main").Range("A65536").End(xlUp).Offset(1, 0).Value = current

ActiveSheet.Range("F47").Select

Sheets("Main").Range("A65536").End(xlUp).Offset(0, 1).Value = ("='" & current & "'!" & ActiveCell.Address)

ActiveSheet.Range("I50").Select

Sheets("Main").Range("A65536").End(xlUp).Offset(0, 2).Value = ("='" & current & "'!" & ActiveCell.Address)

Sheets("Mat Extended").Range("ALW1").End(xlToLeft).Offset(0, 1).Value = current

Sheets("Mat Extended").Range("ALW2").End(xlToLeft).Offset(0, 1).Value = ("=SUMIF('" & current & "'!$B$3:$B$46,$B2,'" & current & "'!$D$3:$D$46)")

Sheets("Mat Extended").Range("ALW2").End(xlToLeft).Copy

Sheets("Mat Extended").Range("ALW3").End(xlToLeft).Offset(0, 1).Select

/////////////The Line Above is the problem I get an error every time, any suggestions?////////////////////////////////////////////////

Range(Selection, Selection.End(xlDown)).Select

ActiveSheet.Paste

Sheets(current).Range("B3").Select

End Sub

Answer 1

Yeah figured it out right before you replied.  Long road for me though.  I kinda novice at vba for excel.  Most of my knowledge lies in Google Action Script.  For some reason I was getting an error with the deletion of my original with structure so I went back to my original for that.

My Completed Code:

Sub feeder1()

Dim ActNm As String

Dim ShName As String

Dim FillRng As Range

Dim FormulaRng As Range

With ActiveWorkbook.Sheets

Sheets("HelpTemplate").Visible = True

Sheets("HelpTemplate").Select

Sheets("HelpTemplate").Copy after:=Worksheets(Worksheets.Count)

Sheets("HelpTemplate").Visible = False

End With

ActNm = ActiveSheet.Name

On Error Resume Next

ActiveSheet.Name = "Template"

NoName: If Err.Number = 1004 Then ActiveSheet.Name = InputBox("Please Name New System.")

If ActiveSheet.Name = ActNm Then GoTo NoName

On Error GoTo 0

ShName = ActiveSheet.Name

With Sheets("Main")

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ShName

.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = ("='" & ShName & "'!F47")

.Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = ("='" & ShName & "'!I50")

End With

With Sheets("Mat Extended")

.Range("ALW1").End(xlToLeft).Offset(0, 1).Value = ShName

.Range("ALW2").End(xlToLeft).Offset(0, 1).Value = ("=SUMIF('" & ShName _

& "'!$B$3:$B$46,$B2,'" & ShName & "'!$D$3:$D$46)")

Set FormulaRng = .Range("ALW2").End(xlToLeft)

Set FillRng = Range(FormulaRng, FormulaRng.End(xlDown))

FillRng.FillDown

End With

Sheets(ShName).Range("B3").Select

End Sub

Answer 2

My fault, it should have been :

Set FormulaRng= .Range("ALW2") .End(xlToLeft)

Answer 3

I  am getting an error on the line 

Set FormulaRng= .End(xlToLeft)

Answer 4

You can not select a cell on a non active sheet, hence you get an errror.

In general you should not use select statements as they are not needed, and will slow down your code.

I have deleted the With construction in your code, as there are no references to it. To establish a reference to a With object, your statement should have a leading dot ( See the code below).

Here's my improved version of your code. It is not tested,

Sub feeder()

Dim ActNm As String

Dim ShName As String

Dim FillRng As Range

Dim FormulaRng As Range

Sheets("HelpTemplate").Copy after:=Worksheets(Worksheets.Count)

ActNm = ActiveSheet.Name

On Error Resume Next

ActiveSheet.Name = "Template"

NoName: If Err.Number = 1004 Then ActiveSheet.Name = InputBox("Please Name New System.")

If ActiveSheet.Name = ActNm Then GoTo NoName

On Error GoTo 0

ShName = ActiveSheet.Name

With Sheets("Main")

    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ShName

    .Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = ("='" & ShName & "'!F47")

    .Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = ("='" & ShName & "'!I50")

End With

With Sheets("Mat Extended")

    .Range("ALW1").End(xlToLeft).Offset(0, 1).Value = current

    .Range("ALW2").End(xlToLeft).Offset(0, 1).Value = ("=SUMIF('" & ShName _

        & "'!$B$3:$B$46,$B2,'" & ShName & "'!$D$3:$D$46)")

    Set FormulaRng = .End(xlToLeft)

    Set FillRng = Range(FormulaRng, FormulaRng.End(xlDown))

    FillRng.FillDown

End With

Sheets(ShName).Range("B3").Select

End Sub