Export Files

emir0514

New Member
Joined
May 13, 2013
Messages
3
Hello Everyone,

So I created a VBA that creates a report and saves the file based on what is in cell H5 on the Input page and saves it to the directory that is in cell H15 on the Input page. In cell H5 I can select a company name and there is over 30 company names. Rather than running the macro 30 times, I was wondering if there was a way it can go through all the entire list and save them in the same location as 30 separate .xlsx files. Here is my current code that will run it for 1 company.


The very top part of the code is just some formatting on my sheets which would have to remain the same way for all 30 times it runs it, so maybe loop it somehow? By the way the company names that are in cell H5 are using a Data Validation and the full list can be found in the Sources worksheet H2 to H32. Also what if I were to add a company name? Can we set the paramets for H2 to H100? and then just skip over it if the cell is blank.

Thank you!!

Code:
Sub TEST4()
'

Dim rs As Worksheet
    Sheets("BS_Entity").Select
    Range("G10:K10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
    Sheets("IS_Entity").Select
    Range("G10:K10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
    Sheets(Array("BS_Entity", "IS_Entity")).Select
    Sheets("IS_Entity").Activate
    Sheets(Array("BS_Entity", "IS_Entity")).Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("IS_Entity").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Columns("A:C").Select
    Range("C1").Activate
    Selection.Delete Shift:=xlToLeft
    Sheets("IS_Entity").Select
    ActiveSheet.Name = "IS"
    Range("A1").Select
    Sheets("BS_Entity").Select
    Columns("A:C").Select
    Range("C1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveSheet.Name = "BS"
    Range("A1").Select
    
    
 
    Dim strPath As String
    Dim strFolderPath As String
    strFolderPath = Sheet1.Range("H15").Value
    strPath = strFolderPath & _
        Sheet1.Range("H5").Value & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=strPath
    
    ActiveWorkbook.Close
End Sub
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Watch MrExcel Video

Forum statistics

Threads
1,122,193
Messages
5,594,774
Members
413,934
Latest member
austinb

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