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 15:08 by peter