Copy Formula to Last Cell containing Value=1

[And re]

Hello dear helpers!

I have a problem with a VBA Code I use and cannot figure out how to solve my problem.
I hope you can help me!

This is the code:

[COLOR=#0000EE]Sub[/COLOR] RefreshDataRows()
    [COLOR=#0000EE]Dim[/COLOR] Z, EZ [COLOR=#0000EE]As[/COLOR] [COLOR=#0000EE]Integer[/COLOR]
    
    EZ = 6 
    
    [COLOR=#0000EE]With[/COLOR] Sheets([COLOR=#FF0000]"ReportTabelle"[/COLOR])
        [COLOR=#0000EE]If[/COLOR] [COLOR=#0000EE]WorksheetFunction[/COLOR].Count(.Columns([COLOR=#DDAA00]1[/COLOR])) > [COLOR=#DDAA00]0[/COLOR] [COLOR=#0000EE]Then[/COLOR]
            [COLOR=#0000EE]For[/COLOR] [COLOR=#0000EE]Each[/COLOR] Z [COLOR=#0000EE]In[/COLOR] .Columns([COLOR=#DDAA00]1[/COLOR]).SpecialCells(xlCellTypeConstants, [COLOR=#DDAA00]1[/COLOR])
                Z.Offset([COLOR=#DDAA00]0[/COLOR], [COLOR=#DDAA00]1[/COLOR]).Resize([COLOR=#DDAA00]1[/COLOR], [COLOR=#DDAA00]51[/COLOR]).FormulaR1C1 = .Cells(EZ, [COLOR=#DDAA00]2[/COLOR]).Resize([COLOR=#DDAA00]1[/COLOR], [COLOR=#DDAA00]51[/COLOR]).FormulaR1C1
            [COLOR=#0000EE]Next[/COLOR]
            
        [COLOR=#0000EE]Else[/COLOR]
            MsgBox [COLOR=#FF0000]"Error A1: No entries found"[/COLOR]
        
        [COLOR=#0000EE]End[/COLOR] [COLOR=#0000EE]If[/COLOR]
    [COLOR=#0000EE]End[/COLOR] [COLOR=#0000EE]With[/COLOR]
[COLOR=#0000EE]End[/COLOR] [COLOR=#0000EE]Sub[/COLOR]

What I wanted to achieve is that the formula in Row 6 is copied down to every row (from 6 downwards) that contains a 1 (as a number) in Column "A"

I get the 1004 run time error.

Thank you a lot!

Andre

 

[Fluff]

Hi & welcome to the board.
How about

Sub RefreshDataRows()
    Dim Z As Range, EZ As Integer
    
    EZ = 6
    
    With Sheets("ReportTabelle")
        If WorksheetFunction.count(.Columns(1)) > 0 Then
            For Each Z In .Range("A6", .Range("A" & Rows.count).End(xlUp))
               If Z.Value = 1 Then Z.Offset(0, 1).Resize(1, 51).FormulaR1C1 = .Cells(EZ, 2).Resize(1, 51).FormulaR1C1
            Next
        Else
            MsgBox "Error A1: No entries found"
        End If
    End With
End Sub