User Tools

Site Tools


microsoft_excel:macros:copy:copy_formulae_down_on_a_sheet

Microsoft Excel - Macros - Copy - Copy formulae down on a sheet

' Copy formulae down on the Test1 sheet.
Sub Copy_Formulae_Down()
 
    Dim mycell As Variant
    Dim lastrow_Test1 As Long
    Dim Pmt_Curr As Variant
    Dim FX_Rate As Variant
 
 
 
    ' Ask user.
    If ctrl_ask_before_running_subroutine = True Then
        If MsgBox("Copy formulae down?", vbYesNo) = vbNo Then Exit Sub
    End If
 
 
    ' Update StatusBar.
    Application.StatusBar = "Copy formulae down..."
 
 
    With Workbooks(wb_name)
 
        With .Sheets("Test1")
 
            ' Activate the Test1 sheet.
            .Activate
 
 
            ' Get how many rows of data have been loaded into the sheet.
            lastrow_Test1 = .Cells(Rows.Count, 4).End(xlUp).Row
            ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
            If lastrow_Test1 < 3 Then
                lastrow_Test1 = 3
            End If
 
 
            ' Ensure that FX_Rate has a default value.
            'For Each mycell In Workbooks(my1042Rec).Sheets("Test1").Range("AE2", Range("AE65536").End(xlUp))
            For Each mycell In .Range("AE2:AE" & lastrow_Test1)
                If Not mycell Like "*[0-9]*" Then mycell.Formula = 1
            Next mycell
 
 
            ' Copy using autofill.
            .Range("A2:A2").AutoFill Destination:=.Range("A2:A" & lastrow_Test1)
            .Range("B2:C2").AutoFill Destination:=.Range("B2:C" & lastrow_Test1)
            .Range("E2").AutoFill Destination:=.Range("E2:E" & lastrow_Test1)
            .Range("K2:L2").AutoFill Destination:=.Range("K2:L" & lastrow_Test1)
 
 
            ' Copy using a resize.  Some say much quicker than alternative solutions, but not proven.
            ' Destination is lastrow -1 as need to exclude header row.
            'Dim rngSource As Range
            'Dim rngTarget As Range
            '    Set rngSource = .Range("A2:A2")
            '    Set rngTarget = Range("A2:A2")
            '    rngTarget.Resize(lastrow_Test1 - 1, rngSource.Columns.Count).Formula = rngSource.Formula
 
 
            ' Ensure that Payment Currency is set to something.  Default to USD for unknowns.
            For Each Pmt_Curr In .Range("G2:G" & lastrow_Test1)
                If RTrim(LTrim(Pmt_Curr)) = "" Then Pmt_Curr.Value = "USD"
            Next Pmt_Curr
 
 
            ' Ensure that the FX Rate is set to a valid number.  Default to 1 for unknowns.
            For Each FX_Rate In .Range("AE2:AE" & lastrow_Test1)
                If IsNumeric(FX_Rate) = False Then FX_Rate.Value = 1
            Next FX_Rate
 
 
            ' Calculations.
            .Range("E2:E" & lastrow_Test1).Calculate
            .Range("A2:A" & lastrow_Test1).Calculate
            .Range("K2:L" & lastrow_Test1).Calculate
            .Range("B2:C" & lastrow_Test1).Calculate
 
 
            ' Now copy and paste formula ranges as values to speed up the file processing.
            .Range("A3:A" & lastrow_Test1) = .Range("A3:A" & lastrow_Test1).Value
            .Range("B3:C" & lastrow_Test1) = .Range("B3:C" & lastrow_Test1).Value
            .Range("E3:E" & lastrow_Test1) = .Range("E3:E" & lastrow_Test1).Value
            .Range("K3:L" & lastrow_Test1) = .Range("K3:L" & lastrow_Test1).Value
 
 
            ' Select A1.
            ScrollTo ActiveSheet.name, "A1"
 
        End With
    End With
 
 
    ' Clear all objects.
    Set mycell = Nothing
    Set Pmt_Curr = Nothing
    Set FX_Rate = Nothing
 
End Sub

or

' Copies formulae down on the Sheet1 sheet.
Sub Copy_Formulae_Down()
 
    Dim lastrow_Sheet1 As Long
 
 
 
    ' Ask user.
    If ctrl_ask_before_running_subroutine = True Then
        If MsgBox("Copy formulae down?", vbYesNo) = vbNo Then Exit Sub
    End If
 
 
    ' Update StatusBar.
    Application.StatusBar = "Copy Formulae down..."
 
 
    With Workbooks(wb_name)
 
        With .Sheets("sheet1")
 
            ' Activate the sheet.
            .Activate
 
            ' Get how many rows of data have been loaded into the sheet.
            lastrow_Sheet1 = .Cells(Rows.Count, 4).End(xlUp).Row
            ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
            If lastrow_Sheet1 < 3 Then
                lastrow_Sheet1 = 3
            End If
 
 
            ' Copies formulae down.
            .Range("F2:F2").AutoFill Destination:=.Range("F2:F" & lastrow_Sheet1)
            .Range("F2:F" & lastrow_Sheet1).Calculate
            .Range("F3:F" & lastrow_Sheet1) = .Range("F3:F" & lastrow_Sheet1).Value
 
            .Range("H2:H2").AutoFill Destination:=.Range("H2:H" & lastrow_Sheet1)
            .Range("H2:H" & lastrow_Sheet1).Calculate
            .Range("H3:H" & lastrow_Sheet1) = .Range("H3:H" & lastrow_Sheet1).Value
 
            .Range("J2:J2").AutoFill Destination:=.Range("J2:J" & lastrow_Sheet1)
            .Range("J2:J" & lastrow_Sheet1).Calculate
            .Range("J3:J" & lastrow_Sheet1) = .Range("J3:J" & lastrow_Sheet1).Value
 
            .Range("L2:L2").AutoFill Destination:=.Range("L2:L" & lastrow_Sheet1)
            .Range("L2:L" & lastrow_Sheet1).Calculate
            .Range("L3:L" & lastrow_Sheet1) = .Range("L3:L" & lastrow_Sheet1).Value
 
            .Range("M2:M2").AutoFill Destination:=.Range("M2:M" & lastrow_Sheet1)
            .Range("M2:M" & lastrow_Sheet1).Calculate
            .Range("M3:M" & lastrow_Sheet1) = .Range("M3:M" & lastrow_Sheet1).Value
 
            .Range("T2:T2").AutoFill Destination:=.Range("T2:T" & lastrow_Sheet1)
            .Range("T2:T" & lastrow_Sheet1).Calculate
            .Range("T3:T" & lastrow_Sheet1) = .Range("T3:T" & lastrow_Sheet1).Value
 
            .Range("V2:V2").AutoFill Destination:=.Range("V2:V" & lastrow_Sheet1)
            .Range("V2:V" & lastrow_Sheet1).Calculate
            .Range("V3:V" & lastrow_Sheet1) = .Range("V3:V" & lastrow_Sheet1).Value
 
            .Range("W2:W2").AutoFill Destination:=.Range("W2:W" & lastrow_Sheet1)
            .Range("W2:W" & lastrow_Sheet1).Calculate
            .Range("W3:W" & lastrow_Sheet1) = .Range("W3:W" & lastrow_Sheet1).Value
 
            .Range("X2:X2").AutoFill Destination:=.Range("X2:X" & lastrow_Sheet1)
            .Range("X2:X" & lastrow_Sheet1).Calculate
            .Range("X3:X" & lastrow_Sheet1) = .Range("X3:X" & lastrow_Sheet1).Value
 
            .Range("AB2:AB2").AutoFill Destination:=.Range("AB2:AB" & lastrow_Sheet1)
            .Range("AB2:AB" & lastrow_Sheet1).Calculate
            .Range("AB3:AB" & lastrow_Sheet1) = .Range("AB3:AB" & lastrow_Sheet1).Value
 
            .Range("AC2:AC2").AutoFill Destination:=.Range("AC2:AC" & lastrow_Sheet1)
            .Range("AC2:AC" & lastrow_Sheet1).Calculate
            .Range("AC3:AC" & lastrow_Sheet1) = .Range("AC3:AC" & lastrow_Sheet1).Value
 
            .Range("AE2:AE2").AutoFill Destination:=.Range("AE2:AE" & lastrow_Sheet1)
            .Range("AE2:AE" & lastrow_Sheet1).Calculate
            .Range("AE3:AE" & lastrow_Sheet1) = .Range("AE3:AE" & lastrow_Sheet1).Value
 
            .Range("AG2:AG2").AutoFill Destination:=.Range("AG2:AG" & lastrow_Sheet1)
            .Range("AG2:AG" & lastrow_Sheet1).Calculate
            .Range("AG3:AG" & lastrow_Sheet1) = .Range("AG3:AG" & lastrow_Sheet1).Value
 
            .Range("AH2:AH2").AutoFill Destination:=.Range("AH2:AH" & lastrow_Sheet1)
            .Range("AH2:AH" & lastrow_Sheet1).Calculate
            .Range("AH3:AH" & lastrow_Sheet1) = .Range("AH3:AH" & lastrow_Sheet1).Value
 
            .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_Sheet1)
            .Range("AJ2:AJ" & lastrow_Sheet1).Calculate
            .Range("AJ3:AJ" & lastrow_Sheet1) = .Range("AJ3:AJ" & lastrow_Sheet1).Value
 
            .Range("AK2:AK2").AutoFill Destination:=.Range("AK2:AK" & lastrow_Sheet1)
            .Range("AK2:AK" & lastrow_Sheet1).Calculate
            .Range("AK3:AK" & lastrow_Sheet1) = .Range("AK3:AK" & lastrow_Sheet1).Value
 
            .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_Sheet1)
            .Range("AL2:AL" & lastrow_Sheet1).Calculate
            .Range("AL3:AL" & lastrow_Sheet1) = .Range("AL3:AL" & lastrow_Sheet1).Value
 
            .Range("AN2:AN2").AutoFill Destination:=.Range("AN2:AN" & lastrow_Sheet1)
            .Range("AN2:AN" & lastrow_Sheet1).Calculate
            .Range("AN3:AN" & lastrow_Sheet1) = .Range("AN3:AN" & lastrow_Sheet1).Value
 
            .Range("AO2:AO2").AutoFill Destination:=.Range("AO2:AO" & lastrow_Sheet1)
            .Range("AO2:AO" & lastrow_Sheet1).Calculate
            .Range("AO3:AO" & lastrow_Sheet1) = .Range("AO3:AO" & lastrow_Sheet1).Value
 
            .Range("AP2:AP2").AutoFill Destination:=.Range("AP2:AP" & lastrow_Sheet1)
            .Range("AP2:AP" & lastrow_Sheet1).Calculate
            .Range("AP3:AP" & lastrow_Sheet1) = .Range("AP3:AP" & lastrow_Sheet1).Value
 
            .Range("AQ2:AQ2").AutoFill Destination:=.Range("AQ2:AQ" & lastrow_Sheet1)
            .Range("AQ2:AQ" & lastrow_Sheet1).Calculate
            .Range("AQ3:AQ" & lastrow_Sheet1) = .Range("AQ3:AQ" & lastrow_Sheet1).Value
 
            .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_Sheet1)
            .Range("AR2:AR" & lastrow_Sheet1).Calculate
            .Range("AR3:AR" & lastrow_Sheet1) = .Range("AR3:AR" & lastrow_Sheet1).Value
 
            .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_Sheet1)
            .Range("AS2:AS" & lastrow_Sheet1).Calculate
            .Range("AS3:AS" & lastrow_Sheet1) = .Range("AS3:AS" & lastrow_Sheet1).Value
 
            .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_Sheet1)
            .Range("AT2:AT" & lastrow_Sheet1).Calculate
            .Range("AT3:AT" & lastrow_Sheet1) = .Range("AT3:AT" & lastrow_Sheet1).Value
 
            .Range("AV2:AV2").AutoFill Destination:=.Range("AV2:AV" & lastrow_Sheet1)
            .Range("AV2:AV" & lastrow_Sheet1).Calculate
            .Range("AV3:AV" & lastrow_Sheet1) = .Range("AV3:AV" & lastrow_Sheet1).Value
 
            .Range("AW2:AW2").AutoFill Destination:=.Range("AW2:AW" & lastrow_Sheet1)
            .Range("AW2:AW" & lastrow_Sheet1).Calculate
            .Range("AW3:AW" & lastrow_Sheet1) = .Range("AW3:AW" & lastrow_Sheet1).Value
 
            .Range("AX2:AX2").AutoFill Destination:=.Range("AX2:AX" & lastrow_Sheet1)
            .Range("AX2:AX" & lastrow_Sheet1).Calculate
            .Range("AX3:AX" & lastrow_Sheet1) = .Range("AX3:AX" & lastrow_Sheet1).Value
 
            .Range("AY2:AY2").AutoFill Destination:=.Range("AY2:AY" & lastrow_Sheet1)
            .Range("AY2:AY" & lastrow_Sheet1).Calculate
            .Range("AY3:AY" & lastrow_Sheet1) = .Range("AY3:AY" & lastrow_Sheet1).Value
 
            .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_Sheet1)
            .Range("BB2:BB" & lastrow_Sheet1).Calculate
            .Range("BB3:BB" & lastrow_Sheet1) = .Range("BB3:BB" & lastrow_Sheet1).Value
 
            .Range("BD2:BD2").AutoFill Destination:=.Range("BD2:BD" & lastrow_Sheet1)
            .Range("BD2:BD" & lastrow_Sheet1).Calculate
            .Range("BD3:BD" & lastrow_Sheet1) = .Range("BD3:BD" & lastrow_Sheet1).Value
 
            .Range("BE2:BE2").AutoFill Destination:=.Range("BE2:BE" & lastrow_Sheet1)
            .Range("BE2:BE" & lastrow_Sheet1).Calculate
            .Range("BE3:BE" & lastrow_Sheet1) = .Range("BE3:BE" & lastrow_Sheet1).Value
 
            .Range("BG2:BG2").AutoFill Destination:=.Range("BG2:BG" & lastrow_Sheet1)
            .Range("BG2:BG" & lastrow_Sheet1).Calculate
            .Range("BG3:BG" & lastrow_Sheet1) = .Range("BG3:BG" & lastrow_Sheet1).Value
 
            .Range("BH2:BH2").AutoFill Destination:=.Range("BH2:BH" & lastrow_Sheet1)
            .Range("BH2:BH" & lastrow_Sheet1).Calculate
            .Range("BH3:BH" & lastrow_Sheet1) = .Range("BH3:BH" & lastrow_Sheet1).Value
 
            .Range("BI2:BI2").AutoFill Destination:=.Range("BI2:BI" & lastrow_Sheet1)
            .Range("BI2:BI" & lastrow_Sheet1).Calculate
            .Range("BI3:BI" & lastrow_Sheet1) = .Range("BI3:BI" & lastrow_Sheet1).Value
 
            .Range("BJ2:BJ2").AutoFill Destination:=.Range("BJ2:BJ" & lastrow_Sheet1)
            .Range("BJ2:BJ" & lastrow_Sheet1).Calculate
            .Range("BJ3:BJ" & lastrow_Sheet1) = .Range("BJ3:BJ" & lastrow_Sheet1).Value
 
            .Range("BK2:BK2").AutoFill Destination:=.Range("BK2:BK" & lastrow_Sheet1)
            .Range("BK2:BK" & lastrow_Sheet1).Calculate
            .Range("BK3:BK" & lastrow_Sheet1) = .Range("BK3:BK" & lastrow_Sheet1).Value
 
            .Range("BL2:BL2").AutoFill Destination:=.Range("BL2:BL" & lastrow_Sheet1)
            .Range("BL2:BL" & lastrow_Sheet1).Calculate
            .Range("BL3:BL" & lastrow_Sheet1) = .Range("BL3:BL" & lastrow_Sheet1).Value
 
            .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_Sheet1)
            .Range("BM2:BM" & lastrow_Sheet1).Calculate
            .Range("BM3:BM" & lastrow_Sheet1) = .Range("BM3:BM" & lastrow_Sheet1).Value
 
        End With
    End With
End Sub
microsoft_excel/macros/copy/copy_formulae_down_on_a_sheet.txt · Last modified: 2021/08/04 16:08 by peter

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki