Run same excel macros on multiple excel files

Z

zach9208

Board Regular
Joined
Dec 15, 2015
Messages
117
I am looking to combine these macros. I need this macro to scrub through a folder and open up each workbook and update the column headings. The only catch is I need the two different tabs to get different headings. The two sheet names within each workbook are called "CRM" and "Aspirational"

Code: 
Sub ProcessFiles()    Dim Filename, Pathname As String
    Dim wb As Workbook


    Pathname = "C:\Users\c755748\Desktop\TEST2\"
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

Code: 
Sub DoWork(wb As Workbook)    With wb
        'Call UpdateHeadersAspirational
        'Call CRM
    End With
End Sub


Code: 
Sub UpdateHeadersAspirational()
[COLOR=#ff0000]With Sheets("Aspirational").Select[/COLOR]
    


[A1].Formula = "FCAST_BTQ_NM"
[B1].Formula = "EST_MNDT_USD_AMT"
[C1].Formula = "INV_VHCL_NM"
[D1].Formula = "EST_FDNG_QTR_NM"
[E1].Formula = "STAT_UPDT_TXT"
[F1].Formula = "OPTY_NMBR"
[G1].Formula = "CO_NM"
[H1].Formula = "CNSLT_NM"
[I1].Formula = "PRMY_PRDCT_NM"
[J1].Formula = "BTQ_PRMY_PRDCT_TYP_NM"
[K1].Formula = "INV_VHCL_2_NM"
[L1].Formula = "PLNE_STP_NM"
[M1].Formula = "RNKG_TYP_NM"
[N1].Formula = "CRNCY_NM"
[O1].Formula = "EST_MNDT_AMT"
[P1].Formula = "EST_DCSN_DT"
[Q1].Formula = "TM_MBR_NM"
[R1].Formula = "RGN_4_NM"
[S1].Formula = "OPTY_TYP_NM"
[T1].Formula = "MOD_DT"




End With
End Sub

Code: 
Sub UpdateHeadersCRM()
[COLOR=#ff0000]With Sheets("CRM").Select[/COLOR]
    


[A1].Formula = "WGTD_SLS_CAL_AMT"
[B1].Formula = "SLS_ROLE_NM"
[C1].Formula = "INV_VHCL_NM"
[D1].Formula = "EST_FDNG_QTR_NM"
[E1].Formula = "PCT_EST_MNDT"
[F1].Formula = "WT_PRC"
[G1].Formula = "AVG_BPS_AMT"
[H1].Formula = "OPTY_NMBR"
[I1].Formula = "CO_NM"
[J1].Formula = "CNSLT_NM"
[K1].Formula = "PRMY_PRDCT_NM"
[L1].Formula = "BTQ_PRMY_PRDCT_TYP_NM"
[M1].Formula = "INV_VHCL_2_NM"
[N1].Formula = "PLNE_STP_NM"
[O1].Formula = "RNKG_TYP_NM"
[P1].Formula = "CRNCY_NM"
[Q1].Formula = "EST_MNDT_AMT"
[R1].Formula = "EST_MNDT_USD_AMT"
[S1].Formula = "EST_DCSN_DT"
[T1].Formula = "TM_MBR_NM"
[U1].Formula = "RGN_4_NM"
[V1].Formula = "OPTY_TYP_NM"
[W1].Formula = "MOD_DT"




End With
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Try this.
Code: 
Sub ProcessFiles()
Dim wb As Workbook
Dim Filename As String, Pathname As String

    Pathname = "C:\Users\c755748\Desktop\TEST2\"
    Filename = Dir(Pathname & "*.xls")

    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop

End Sub

Sub DoWork(wb As Workbook)

    UpdateHeadersAspirational wb.Sheets("Aspirational")
    UpdateHeadersCRM wb.Sheets("CRM")

End Sub

Sub UpdateHeadersAspirational(ws As Worksheet)

    With ws
        .Range("A1").Value = "FCAST_BTQ_NM"
        .Range("B1").Value = "EST_MNDT_USD_AMT"
        .Range("C1").Value = "INV_VHCL_NM"
        .Range("D1").Value = "EST_FDNG_QTR_NM"
        .Range("E1").Value = "STAT_UPDT_TXT"
        .Range("F1").Value = "OPTY_NMBR"
        .Range("G1").Value = "CO_NM"
        .Range("H1").Value = "CNSLT_NM"
        .Range("I1").Value = "PRMY_PRDCT_NM"
        .Range("J1").Value = "BTQ_PRMY_PRDCT_TYP_NM"
        .Range("K1").Value = "INV_VHCL_2_NM"
        .Range("L1").Value = "PLNE_STP_NM"
        .Range("M1").Value = "RNKG_TYP_NM"
        .Range("N1").Value = "CRNCY_NM"
        .Range("O1").Value = "EST_MNDT_AMT"
        .Range("P1").Value = "EST_DCSN_DT"
        .Range("Q1").Value = "TM_MBR_NM"
        .Range("R1").Value = "RGN_4_NM"
        .Range("S1").Value = "OPTY_TYP_NM"
        .Range("T1").Value = "MOD_DT"
    End With
    
End Sub

Sub UpdateHeadersCRM(ws As Worksheet)

    With ws
        .Range("A1").Value = "WGTD_SLS_CAL_AMT"
        .Range("B1").Value = "SLS_ROLE_NM"
        .Range("C1").Value = "INV_VHCL_NM"
        .Range("D1").Value = "EST_FDNG_QTR_NM"
        .Range("E1").Value = "PCT_EST_MNDT"
        .Range("F1").Value = "WT_PRC"
        .Range("G1").Value = "AVG_BPS_AMT"
        .Range("H1").Value = "OPTY_NMBR"
        .Range("I1").Value = "CO_NM"
        .Range("J1").Value = "CNSLT_NM"
        .Range("K1").Value = "PRMY_PRDCT_NM"
        .Range("L1").Value = "BTQ_PRMY_PRDCT_TYP_NM"
        .Range("M1").Value = "INV_VHCL_2_NM"
        .Range("N1").Value = "PLNE_STP_NM"
        .Range("O1").Value = "RNKG_TYP_NM"
        .Range("P1").Value = "CRNCY_NM"
        .Range("Q1").Value = "EST_MNDT_AMT"
        .Range("R1").Value = "EST_MNDT_USD_AMT"
        .Range("S1").Value = "EST_DCSN_DT"
        .Range("T1").Value = "TM_MBR_NM"
        .Range("U1").Value = "RGN_4_NM"
        .Range("V1").Value = "OPTY_TYP_NM"
        .Range("W1").Value = "MOD_DT"
    End With
    
End Sub
 
Upvote 0
Thanks, Norie, this worked great! Is there any way the code can be tweaked so it does not open the files up on screen? I rather it just run behind the scenes with no screen updating.
Norie said:
Try this.
Code: 
Sub ProcessFiles()
Dim wb As Workbook
Dim Filename As String, Pathname As String

    Pathname = "C:\Users\c755748\Desktop\TEST2\"
    Filename = Dir(Pathname & "*.xls")

    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop

End Sub

Sub DoWork(wb As Workbook)

    UpdateHeadersAspirational wb.Sheets("Aspirational")
    UpdateHeadersCRM wb.Sheets("CRM")

End Sub

Sub UpdateHeadersAspirational(ws As Worksheet)

    With ws
        .Range("A1").Value = "FCAST_BTQ_NM"
        .Range("B1").Value = "EST_MNDT_USD_AMT"
        .Range("C1").Value = "INV_VHCL_NM"
        .Range("D1").Value = "EST_FDNG_QTR_NM"
        .Range("E1").Value = "STAT_UPDT_TXT"
        .Range("F1").Value = "OPTY_NMBR"
        .Range("G1").Value = "CO_NM"
        .Range("H1").Value = "CNSLT_NM"
        .Range("I1").Value = "PRMY_PRDCT_NM"
        .Range("J1").Value = "BTQ_PRMY_PRDCT_TYP_NM"
        .Range("K1").Value = "INV_VHCL_2_NM"
        .Range("L1").Value = "PLNE_STP_NM"
        .Range("M1").Value = "RNKG_TYP_NM"
        .Range("N1").Value = "CRNCY_NM"
        .Range("O1").Value = "EST_MNDT_AMT"
        .Range("P1").Value = "EST_DCSN_DT"
        .Range("Q1").Value = "TM_MBR_NM"
        .Range("R1").Value = "RGN_4_NM"
        .Range("S1").Value = "OPTY_TYP_NM"
        .Range("T1").Value = "MOD_DT"
    End With
    
End Sub

Sub UpdateHeadersCRM(ws As Worksheet)

    With ws
        .Range("A1").Value = "WGTD_SLS_CAL_AMT"
        .Range("B1").Value = "SLS_ROLE_NM"
        .Range("C1").Value = "INV_VHCL_NM"
        .Range("D1").Value = "EST_FDNG_QTR_NM"
        .Range("E1").Value = "PCT_EST_MNDT"
        .Range("F1").Value = "WT_PRC"
        .Range("G1").Value = "AVG_BPS_AMT"
        .Range("H1").Value = "OPTY_NMBR"
        .Range("I1").Value = "CO_NM"
        .Range("J1").Value = "CNSLT_NM"
        .Range("K1").Value = "PRMY_PRDCT_NM"
        .Range("L1").Value = "BTQ_PRMY_PRDCT_TYP_NM"
        .Range("M1").Value = "INV_VHCL_2_NM"
        .Range("N1").Value = "PLNE_STP_NM"
        .Range("O1").Value = "RNKG_TYP_NM"
        .Range("P1").Value = "CRNCY_NM"
        .Range("Q1").Value = "EST_MNDT_AMT"
        .Range("R1").Value = "EST_MNDT_USD_AMT"
        .Range("S1").Value = "EST_DCSN_DT"
        .Range("T1").Value = "TM_MBR_NM"
        .Range("U1").Value = "RGN_4_NM"
        .Range("V1").Value = "OPTY_TYP_NM"
        .Range("W1").Value = "MOD_DT"
    End With
    
End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
Macro Code Help
2 3
Replies
25
Views
2K
Fluff
Fluff

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

Share this page

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