Macro that will take a row with formulas and paste them in each file

copleyr

Active Member
Joined
Aug 24, 2009
Messages
381
Hello all,

I have a row with formulas in each cell. I need a macro that can copy this row and paste it in a tab labeled "DEFAULTS" on row 70, in each excel file, in a desktop folder labeled "ALL".

I need the formulas to be authentic to each file (non-linked to other files).

Is this possible? I need this to be a macro because there are >200 of these excel files. Each file has the same tab labeled "DEFAULTS"

Thank you very much in advance.
 
Last edited:

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Hello Ryan

To transfer the formulas of cells A1 and B1 to cells A70 and B70:

Code:
Sub CopyFormulasInLoop()

    Dim FolderName As String
    Dim Fname As String

    FolderName = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\ALL\"

    Fname = Dir(FolderName & "*.xls")

    Application.ScreenUpdating = False

    Do While Len(Fname)

        With Workbooks.Open(FolderName & Fname)

            .Worksheets("DEFAULTS").Range("A70").Resize(, 2).Formula = ThisWorkbook.Worksheets(1).Range("A1").Resize(, 2).Formula
            .Save
            .Saved = True
            .Close

        End With

        Fname = Dir

    Loop

    Application.ScreenUpdating = True

End Sub
 

copleyr

Active Member
Joined
Aug 24, 2009
Messages
381
Wigi this is perfect! I just have one more small add-on:

I have to add a "header" row to be able to name what the formulas are. I still need the formulas in the 'DEFAULTS' tab for row 70, but I need the headers in row 69.

Is there a way I can get it to copy the headers in cell A1 on "ThisWorkbook.Worksheets(1)" and pastespecial.formats in the defaults tab for row 69? Thus, the formulas would hence start on A2. I will also need this same format carried to row 70 as well.

You are a lifesaver!
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web

ADVERTISEMENT

For instance, untested (code could be shortened though but that could be done afterwards):

Code:
Sub CopyFormulasInLoop()

    Dim FolderName As String
    Dim Fname As String

    FolderName = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\ALL\"

    Fname = Dir(FolderName & "*.xls")

    Application.ScreenUpdating = False

    Do While Len(Fname)

        With Workbooks.Open(FolderName & Fname)

           With .Worksheets("DEFAULTS")
                ThisWorkbook.Worksheets(1).Range("A1:B1").Copy Destination:=.Range("A69")
                .Range("A70:B70").Formula = ThisWorkbook.Worksheets(1).Range("A2:B2").Formula
                .Range("A70").NumberFormat = ThisWorkbook.Worksheets(1).Range("A2").NumberFormat
                .Range("B70").NumberFormat = ThisWorkbook.Worksheets(1).Range("B2").NumberFormat
           End With

            .Save
            .Saved = True
            .Close

        End With

        Fname = Dir

    Loop

    Application.ScreenUpdating = True

End Sub
[/QUOTE]
 

copleyr

Active Member
Joined
Aug 24, 2009
Messages
381
Thanks Wigi! Works perfectly however as I am running the macro for 300 files, it keeps asking if I would like to "update links". I tried to disable that with this code but it does not seem to work. I have tried using true and false: (Application.DisplayAlerts = False)

Code:
Sub CopyFormulasInLoop()
    Dim FolderName As String
    Dim Fname As String
    FolderName = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\ALL\"
    Fname = Dir(FolderName & "*.xls")
    Application.ScreenUpdating = False
    Do While Len(Fname)
        With Workbooks.Open(FolderName & Fname)
           With .Worksheets("DEFAULTS")
                ThisWorkbook.Worksheets(1).Range("A1:CO1").Copy Destination:=.Range("A69")
                .Range("A70:CO70").Formula = ThisWorkbook.Worksheets(1).Range("A2:CO2").Formula
                .Range("A70").NumberFormat = ThisWorkbook.Worksheets(1).Range("A2").NumberFormat
                .Range("B70").NumberFormat = ThisWorkbook.Worksheets(1).Range("B2").NumberFormat
           End With
            .Save
            .Saved = True
            .Close
        End With
        Fname = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
End Sub

Any suggestions? Thanks again for your help!
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web

ADVERTISEMENT

The 2nd argument in the Workbooks.Open command is whether you want to update links or not.
 

copleyr

Active Member
Joined
Aug 24, 2009
Messages
381
I tried this for both true and false but the notification still pops up:

Code:
Sub CopyFormulasInLoop()
    Dim FolderName As String
    Dim Fname As String
    FolderName = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\ALL\"
    Fname = Dir(FolderName & "*.xls")
    Application.ScreenUpdating = False
    Do While Len(Fname)
        With Workbooks.Open(FolderName & Fname)
        Application.DisplayAlerts = True
           With .Worksheets("DEFAULTS")
                ThisWorkbook.Worksheets(1).Range("A1:CO1").Copy Destination:=.Range("A69")
                .Range("A70:CO70").Formula = ThisWorkbook.Worksheets(1).Range("A2:CO2").Formula
                .Range("A70").NumberFormat = ThisWorkbook.Worksheets(1).Range("A2").NumberFormat
                .Range("B70").NumberFormat = ThisWorkbook.Worksheets(1).Range("B2").NumberFormat
           End With
            .Save
            .Saved = True
            .Close
        End With
        Fname = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
End Sub
 

copleyr

Active Member
Joined
Aug 24, 2009
Messages
381
I'm stuck lol. I've tried everything to get the "update links" notification to quick popping up after each file.
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
With Workbooks.Open(FolderName & Fname, 2)

You just have to put the cursor of the word open and hit F1. Then choose help on "Workbooks.Open". There we can see that the parameter 2 for UpdateLinks means that links are never updated, and no warning is issued.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,384
Messages
5,601,326
Members
414,443
Latest member
lionking15

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
Top