Friday, August 7, 2015

VBA script to copy formulas from a row to the rest of rows

Public Function LastRowNum(Sheet As Worksheet) As Integer
    LastRowNum = Sheet.Cells(Sheet.Rows.count, "A").End(xlUp).Row
End Function

Function StringToArray(entries As String, Optional delimiter As String = ",") As Variant
    StringToArray = Split(entries, delimiter)
End Function

Sub CopyFormulas(copyFormula as string)
    Dim firstRow As Integer, firstCol As Integer, lastCol As Integer, lastRow As Integer
    Dim FormulaArray() As String

    FormulaArray = StringToArray(copyFormula, ":")
    firstRow = ActiveSheet.Range(FormulaArray(LBound(FormulaArray))).Row
    firstCol = ActiveSheet.Range(FormulaArray(LBound(FormulaArray))).Column
    lastRow = LastRowNum(ActiveSheet)
    lastCol = ActiveSheet.Range(FormulaArray(UBound(FormulaArray))).Column
        
    ActiveSheet.Range(ActiveSheet.Cells(firstRow, firstCol), ActiveSheet.Cells(firstRow, lastCol)).Copy
    ActiveSheet.Range(ActiveSheet.Cells(firstRow + 1, firstCol), ActiveSheetCells(lastRow, lastCol)).PasteSpecial xlPasteFormulasAndNumberFormats
End Sub

No comments: