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

[copleyr]

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.

 

[copleyr]

bump

 

[wigi]

Hello Ryan

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

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]

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]

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

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]

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)

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]

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

 

[copleyr]

I tried this for both true and false but the notification still pops up:

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]

I'm stuck lol. I've tried everything to get the "update links" notification to quick popping up after each file.

 

[wigi]

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.