Macro to open multiple files

Here's a look at something similar I did awhile back (had to collect data from 2.5 years worth of weekly reports...so...lots of files had to be opened/copied from/closed again).

THis snippet of code is by no means state of the art (first time I've looped over a directory since microsoft depricated application.filesearch methods (which happened 4 years ago))

But, you can hack away at it and get something useful out.

################################################################

Sub LoopWithDirFunction()

Dim summationBook As Workbook
Dim sourceBook As Workbook
Dim souceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim where1, where2 As Range

'Prompt the user for the folder containing the files to be recap'd
myPath = InputBox("Please enter the exact path to the folder containing the reports")

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the recap report
Set summationBook = ThisWorkbook

Do
    '************************************************************************
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set SourceData = sourceBook.Worksheets("USOnA")
        '********************************************************************
        Set where1 = SourceData.Range("A:A")
        Set where2 = where1.Find(what:="Appalachia")
'I WAS LOOKING FOR A TABLE UNDER A KEY WORD / YOUR SEARCH CRITERIA HERE
        
        SourceData.Activate
'YOUR SELECTION CRITERIA HERE 
        Selection.Copy
        
        summationBook.Worksheets(1).Activate
'YOUR PASTE PLACEMENT CRITERIA HERE
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
                       
        '********************************************************************
    sourceBook.Close
    '************************************************************************

'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

End Sub

################################################################

Hi paperwings25

It's a bit difficult sharing an approach since you haven't given basic required information.

What are the File Names of your 13 Accounting files?

What's the Sheet Name that contains the required data in each of the 13 files?

What Accounting File Name/Sheet Name goes into which Master File worksheet?

Are the file structures of the Accounting File worksheets the same in all respects as the file structures of the Master File worksheets?

If you want this...

someone else chimes in and gives me a nice, perfect macro

you'll need to provide samples of the Accounting File workbooks so whatever code we come up with can be tested.

hello again. Quick note:

This macro assumes all the files you want to access are in one place (you mentioned in your first post that you save 13 reports to one folder).

Once you give it the PATH to this folder (like C:\MyReports\Today). It simply opens all .xlsx files in that folder (directory), accesses sheet1, and closes them.

i suggest you Step-Through (run it line-by-line) to see what is happening. Then if you need help with a particular function (like when each sheet is open i need to paste all rows from XYZ tab to the master books 123 tab....) it will be easy to help you.

Sub LoopWithDirFunction()

Dim summationBook As Workbook
Dim sourceBook As Workbook
Dim souceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim where1, where2 As Range

'Prompt the user for the folder containing the files to be recap'd
myPath = InputBox("Please enter the exact path to the folder containing the reports")

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the recap report
Set summationBook = ThisWorkbook

Do
    '************************************************************************
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    'this Macro will access "Sheet1" of each workbook....substitute a specific sheet name here (will assume to be the same for all books)
    Set SourceData = sourceBook.Worksheets("Sheet1")
        '********************************************************************
       '*
       '*  This is where you do whatever you want with each book
       '*                   
        '********************************************************************
    sourceBook.Close
    '************************************************************************

'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

End Sub

This could be handled another way, the line that says
[code]set summationbook = thisworkbook[\code] means the variable "summationbook" will point to the actual book containing the macro for the duration of the routine.

So, you could copy this macro to each of the four "master" books. Each would be the summation book when that book ran the macro -- & each macro would then need to point to the folder for that "master" books 13 reports.

But, that's something you can enter when prompted.

--
what ranges are you looking to copy paste? if you can provide a basic example i could help you get started.

Originally Posted by GeneralDisarray

This could be handled another way, the line that says
[code]set summationbook = thisworkbook[\code] means the variable "summationbook" will point to the actual book containing the macro for the duration of the routine.

So, you could copy this macro to each of the four "master" books. Each would be the summation book when that book ran the macro -- & each macro would then need to point to the folder for that "master" books 13 reports.

But, that's something you can enter when prompted.

--
what ranges are you looking to copy paste? if you can provide a basic example i could help you get started.

I just Ctrl + A(Or I click the top left corner that selects the entire file) and select all when I do all the copying and pasting. So for company 1, in tabs Page 2, Page 3, Page 4, Page 6, nVision TB, Exh 1, Exh 7, Exh 8_1, Exh 8_2, Exh 9, Exh 12, Exh Cap GL, and Exh NII, I just copy all data from my 13 reports and paste them into those tabs that correspond with each report.

Will I have to use IF functions to get the data copied to the correct tabs in the Master File? Like IF("BBPG2",Selection.Copy to Page 2)? I obviously know that is in incorrect code format, but I was just trying to give an example. I am just curious how I will get the correct report to the correct tab in the Master File.

check out this similar post:

http://www.excelforum.com/excel-prog...ml#post2617507

Ok, so if you want Excel to pop open each sheet in sequence...and copy tab-for-tab everything...try this.

Like the other post:

Download the zip file and unzip it.
Then, run the macro (which is in the mastersheet_withMacro file)


The key is the Parts are kept in a folder which sits in the same directory as the master sheet...boo-ya-grand-ma don't forget to rate

Option Explicit

Sub LoopDirectory2()

Dim summationBook As Workbook
Dim i As Long, j As Long, k As Long
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String, myData As String
Dim where1 As Range, where2 As Range

'The parts need to be kept in a folder sitting in the same directory as the master sheet
'and the folder should be names ComponentSheets (or name it whatever you like and change
'the appropriate line (2 lines down) to match your choice
myPath = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name))
myPath = myPath & "ComponentSheets"

'Enter the name of the worksheet that contains the data in the separate books
'for the exmample books I left the name as "Sheet1"
myData = "Sheet1"

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the recap report
Set summationBook = ThisWorkbook

'Clear the summationBook of old data - j marks the end of the collection (on A column).
For j = 1 To summationBook.Worksheets.Count
    summationBook.Worksheets(j).Cells.ClearContents
Next j



Do
    '************************************************************************
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    'Set sourceData = sourceBook.Worksheets(myData)
        '********************************************************************
        'The sourceData will be combed on the "A" column for rows of information
        'Each row (starting below row 1) will be copied to the next available
        'for in the summary book.
       For k = 1 To sourceBook.Worksheets.Count
            For i = 1 To sourceBook.Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
                sourceBook.Worksheets(k).Range("A" & i & ":XFD" & i).Copy Destination:=summationBook.Worksheets(k).Range("A" & summationBook.Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row + 1)
            Next i
       Next k
        '********************************************************************
    sourceBook.Close
    '************************************************************************

'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""


End Sub

Wereyou careful to leave the "ComponentSheets" folder in the directory with the worksheet that is running the macro?

The lines:

myPath = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name))
myPath = myPath & "ComponentSheets"

Require this to be the relative position of the master / component sheets...


EDIT: I've just uploaded another zip file which will help with this point -- after you unzip it, open the folder and run the macro in the master sheet...the ComponentSheets folder will be right were it needs to be.

_____________________________________________________________________________________________________________________________________________________________________


Also, i noticed that i left the file extension as ".xls" instead of ".xlsx" which is what the files actually are...but even with that issue it seems to run just fine for me -- but try changing it to ".xlsx" (unless you are using the '03 version of excel that does indeed use the .xls extension).


Other than that, I suggest that while you are stepping through the code you "mouse-over" the CurrentFileName variable (or add a watch on this variable) and verify that it does indeed pick up the files (at this line)

CurrentFileName = Dir(myPath & "\*.xlsx")

Is "CurrentFileName" is still showing a blank value "" after this line?

I saved your Zipped folder to the desktop. I opened it up, then I opened the master file and ran the macro. This is the error I got...

Screenshot.xlsx

When I scroll over "CurrentFileName" I receive CurrentFileName = "". The myPath is a different directory then what I saved it as. This has to be the issue. Why is it showing that myPath is the temporary Directory when I have saved it on my desktop and opened it from there? I also cannot find this directory that it says myPath is.

are you running it from the zip file. That's what it looks like in that screenshot

'C:\temp\Temporary Directory 2 for TEST2_Folder.zip\Test2.......

you need to extract (unzip the file)...that will place a folder on your desktop named TEST2_Folder....open THAT folder and run the file from there.

does that make sense?

glad to hear it worked.

do you plan to make a new "Master sheet" every day also? If so you would need to make sure each master sheet carried the macro (wouldn't matter what you called the sheet, would only need to contain the macro).

Then, since it's set up to reference a specific "ComponentSheets" folder (as you are now well aware of) you could place the master and the component sheets inside this daily folder....

see my own attached shot...picture is worth a thousand words here

Also...just a geeky style point....when you name by date try the 2011.10.12 format instead of the month-day-year thing.

why? because if you view the balancing folder sorted by name (and they are named year-month-day) it will automatically be sorted by date too!!!

hmm... i think you're going to have to do most of the leg work on this one...you're going to have to fine-tune it to work exactly with what you are doing.

You really can finish it up with practice (stepping through, changing things one line at a time...it's more fun than it sounds). Also, if this is something new to you...what better way to learn.

Actually, i never used VBA until about 5 years ago i hade to clean and combine about 80 multi-sheet workbooks for a total of about 40K lines of data...

Necessity is the best motivator eh?

good luck.

well, if you know the name you would use that name in place of Sheet1. However you can skip that altogether and use an index, or access all the worksheets as a 'collection' using a For Each type loop.

Option1: Identify by worksheet name
example:
Set SourceData = sourceBook.worksheets("SHEET_NAME_HERE")

Option2: Identify by worksheet index
example (this would access the first or left-most worksheet)
Set SourceData = sourceBook.worksheets(1)

Option3: Access all sheets in the book. This would allow you to loop through all the sheets to do whatever you need with them.

For Each sourceData in sourceBook.worksheets
'----------------------
' YOUR CODE HERE
'----------------------
next sourceData

Here is a full example of this (uses a different approach - you need to enable the "Microsoft Scripting Runtime" for this module to work).

This macro looks through a directory with (or without) sub-folders included. It will open each file in the folder, copy the contents from the worksheets of that files to a single sheet.

I was using this module to do something else, but edited it to do what i think you meant to do. Attached book contains this module (run dumpDirectoryDriver to try it out).

enjoy
--

Option Explicit
Public error As String

Sub dumpDirectoryDriver()
    
    Dim fPath As String
    Dim incSubFlds As Boolean
    Dim fType As String
    Dim newBook As Workbook
    Dim newSheet As Worksheet
    On Error GoTo done
    
    error = ""
    
    fPath = InputBox("Enter folder path and press OK.")
    fType = ".xls"
    incSubFlds = True
    Set newBook = Workbooks.Add
    Set newSheet = newBook.Sheets(1)
    
    Application.ScreenUpdating = False
    
    Call dumpDirectory(fPath, fType, incSubFlds, newSheet)
    
    Application.ScreenUpdating = True
    newSheet.Activate
Exit Sub
done:
    MsgBox (error & ".  Operation stopped.")
  
End Sub

Sub dumpDirectory(myPath As String, fileExtension As String, incSub As Boolean, targetSheet As Worksheet)
    
    Dim fso As FileSystemObject
    Dim fld As Folder, subfld As Folder
    Dim fil As File
    Dim wks As Worksheet
    Dim wkb As Workbook
    Dim nextOpenRow As Long, lengthOfSection As Long, widthOfSection As Long, n As Long
    
    On Error GoTo done
    'initialize'
       
        Set fso = New FileSystemObject
        Set fld = fso.GetFolder(myPath)
        
    'open files, dump worksheet contents to target sheet'
        For Each fil In fld.Files
            If UCase(fil.Name) Like "*" & UCase(fileExtension) & "*" Then
                Set wkb = Application.Workbooks.Open(myPath & "\" & fil.Name)
                    For Each wks In wkb.Worksheets
                        nextOpenRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        lengthOfSection = wks.Cells(Rows.Count, 1).End(xlUp).Row
                        widthOfSection = wks.Cells(1, Columns.Count).End(xlToLeft).Column
                        
                        'align values'
                        targetSheet.Range(targetSheet.Cells(nextOpenRow, 1), targetSheet.Cells(nextOpenRow + lengthOfSection - 1, widthOfSection).Address) = _
                        wks.Range(wks.Cells(1, 1).Address, wks.Cells(lengthOfSection, widthOfSection)).Value
                    Next wks
                wkb.Close
            End If
        Next fil
        
    'pass in the subfolders to the listing routine also
    If incSub Then
            For Each subfld In fld.SubFolders
                Call dumpDirectory(myPath & "\" & subfld.Name, fileExtension, True, targetSheet)
            Next subfld
    End If
Exit Sub
done:
    error = Err.Description
    MsgBox (error & ".  Operation stopped.")
End Sub

MINIYUKI1007,

Welcome to the Forum, unfortunately:

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread. It makes sense to have a new thread for your question because a thread with numerous replies can be off putting & difficult to pick out relevant replies.