VBA - Send formulas down to last row of data based on data on another tab-CodePudding

I am trying to figure out a way to send formulas down to the last row of data based on the number of cells on a second tab that have data to capture all values excluding headers.

My formulas are on Sheet1 from cells A4:V4. Rows 1:3 on Sheet1 have headers. The number of cells I am trying to reference are on Sheet2. There are 88 cells with data on Sheet2 including headers on row 1, so 87 unique values. The way I am currently doing it just sends my formulas on Sheet1 down to row 88. I do not want the count to include headers on Sheet2 row 1.

It appears since there are 88 values on Sheet2 that is the total number of rows I am getting on Sheet1 including my 3 rows of headers, so 85 unique values. In total I should see 90 rows total (including existing headers) on Sheet1 but can't figure out how to do that. This is my formula:

Sub AmendRows()

Dim LastRow As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Locktabs False

worksheet1.Select
LastRow = worksheet1.Range("A5").EntireRow.Select
rows(ActiveCell.row & ":" & rows.count).ClearContents
rows(ActiveCell.row & ":" & rows.count).ClearFormats

worksheet1.Range("A4:V4").AutoFill Destination:=worksheet1("A4:V" & worksheet2.range("A" & rows.count).end(xlUp).row)

Locktabs True

worksheetmain.Select
MsgBox "Rows Amended!"


End Sub

Thank you

CodePudding user response：

Sub AmendRows()

    Dim worksheet1 As Worksheet, worksheet2 As Worksheet
    Dim n As Long, rng As Range
    
    Set worksheet1 = Sheet1 ' as appropriate
    Set worksheet2 = Sheet2 ' as appropriate
    
    n = worksheet2.UsedRange.Rows.Count - 1 ' no header
    If n < 1 Then Exit Sub
   
    With worksheet1

        With .Rows("5:" & .Rows.Count)
            .ClearContents
            .ClearFormats
        End With
        
        Set rng = .Range("A4:V4")
        rng.AutoFill Destination:=rng.Resize(n)
        
    End With
    MsgBox n & " Rows Amended! " & rng.Resize(n).Address

End Sub

CodePudding user response：

Copy Formulas Down

Option Explicit

Sub AmendRows()

    Const DST_FIRST_ROW As String = "A4:V4"
    Const SRC_FIRST_CELL As String = "A2"

    Application.ScreenUpdating = False
    'Application.DisplayAlerts = False ' ?
    
    Locktabs False
    
    Dim srCount As Long

    With worksheet2.Range(SRC_FIRST_CELL)
        Dim slCell As Range: Set slCell = .Resize(.Worksheet.Rows.Count - .Row _
              1).Find("*", , xlFormulas, , , xlPrevious)
        If Not slCell Is Nothing Then srCount = slCell.Row - .Row   1
    End With
    
    With worksheet1.Range(DST_FIRST_ROW)
        With .Offset(1).Resize(.Worksheet.Rows.Count - .Row)
            .ClearContents
            .ClearFormats
        End With
        If srCount > 0 Then .Copy .Resize(srCount)
    End With
    
    Locktabs True
    
    If Not worksheetmain Is ActiveSheet Then
        With worksheetmain
            If Not .Parent Is ActiveWorkbook Then .Parent.Activate
            .Select
        End With
    End If

    'Application.DisplayAlerts = True ' ?
    Application.ScreenUpdating = True
    
    MsgBox "Rows Amended!", vbInformation

End Sub