Copy formulas from one worksheet to another macro

kiwikiki718

Board Regular
Joined
Apr 7, 2017
Messages
80
Office Version
  1. 365
Platform
  1. Windows
hello I have a macro that automatically creates column headings based on a Lov list I have within the workbook



I also have worksheet2 that contains formulas that I would need copied over to the new columns in worksheet1.



example:
Each time a new column header is in inserted it is inserted in multiplies of 2 .


I need the first new column to copy over the formula from worksheet 2 column B down for each cell that has a formula &

the 2nd new column to copy over the formula from worksheet2 column C down for each cell that has a formula


for example

Columns C & D were new columns added into worksheet1


I need column C to copy over the formula from worksheet2 Column B which contains 4 formulas and input it into worksheet1 Column C starting at C2


and I need Column D to copy over the formula from worksheet2 Column C which contains 4 formulas and input it into worksheet1 Column D starting at D2

note the first row in each worksheet contains headings.
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
please read the comment starting with <<<<

VBA Code:
Option Explicit

Sub copyFormulas2NewCols()
    Dim vIn As Variant, vOut As Variant
    Dim lRi As Long, lRo1 As Long, lRo2 As Long
    Dim rCol1 As Range
    
    ' set rCol1 to the first cell of the first new column
    Set rCol1 = Sheets("sheet1").Range("A1") '<<<<< you will have to modify your macro to define the first new column and put that here <<<<
    
    'Get the size of the columns B & C in sheet2, and load these two columns into an array
    With Sheets("sheet2")
        lRi = Application.WorksheetFunction.Max(.Cells(.Rows.Count, 2).End(xlUp).Row, .Cells(.Rows.Count, 3).End(xlUp).Row)
        vIn = .Range("B1").Resize(lRi, 2).Formula   'load the formulas.
    End With
    
    'set the output array to the same size as input array
    ReDim vOut(1 To lRi, 1 To 2)
    
    ' set the row counters for each output column to 1
    lRo1 = 1: lRo2 = 1
    'now search each cell in the input array for a formula. It should start with '='
    For lRi = 2 To lRi
        If vIn(lRi, 1) Like "=*" Then
            'copy into next free cell in first column
            vOut(lRo1, 1) = vIn(lRi, 1)
            lRo1 = lRo1 + 1
        End If
        If vIn(lRi, 2) Like "=*" Then
            'copy into next free cell in 2nd column
            vOut(lRo2, 2) = vIn(lRi, 2)
            lRo2 = lRo2 + 1
        End If
        
    Next lRi
    
    'write the output array to sheet 1 below the header row
    rCol1.Offset(1, 0).Resize(UBound(vIn, 1), 2).Formula = vOut
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,203
Members
452,617
Latest member
Narendra Babu D

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top