Transfer Files in a Directory

In Excel VBA if you are consolidating data from multiple sources it is sometimes nice to get the file name the data has come from. This helps identify if there are any issues with the data and provides some context to the data itself. It is often useful to have an Excel sheet showing all of the files in a particular directory. The following method achieves this result;


Option Explicit
Sub GetDirNames() 'Excel VBA to get list of file names
Const sPath="C:\Test\" 'Change to suit
Dim sFil As String

sFil=Dir(sPath & "*.xl*") 'xl here adds flexibility (xl1997 - 2013)

Do While sFil <> ""
Range("D65536").End(xlUp)(2).Value=sPath & sFil
sFil=Dir
Loop
End Sub


In a more practical example you may wish to import data and as you import this data also incorporate the name associated with that data./p>


Open Workbooks in a Directory Import the Current Region


Opening all of the Excel files in a particular directory is a useful tool for consolidating information into a single source. Before the import can happen the code needs to be set up to open all of the files in a given directory. The following will open all of the Excel files and close them without saving the opened file. The VBA merely opens the Excel file, copies the Excel data on the sheet it opens on and closes the file without saving.


Option Explicit
Sub OpenImp() 'Excel VBA to open and import data from the Excel files in a directory
Const sPath="C:\Test\" 'Change to suit
Dim sFil As String
Dim owb As Workbook
Dim ws As Worksheet

Set ws=Sheet1 'Handy as you don't need to refer to the workbook you start from.
sFil=Dir(sPath & "*.xl*") 'Flexible enough to handle all XL file types

Do While sFil <> "" 'Only Copies Cols A to F.
Set owb=Workbooks.Open(sPath & sFil)
Range("A2", Range("F" & Rows.Count).End(xlUp)).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
owb.Close False 'Close no save
sFil=Dir
Loop
End Sub


The procedure copied data from A to F excluding the headings from all of the files in the Directory;

C:\Test\

If you want a different cut of the data you have to change this line of code;

Range("A2", Range("F" & Rows.Count).End(xlUp))

The F needs to change to the Last column of a data to be included. There are further limitation in that it will only copy data on the Active sheet of the open file. This may be all well and good for small files but if the files have multiple sheets you may want to be a bit more specific. We will go into that scenario in the following section.


Open Workbooks in a Directory Import the Current Region

In order to import all of the information in a particular file it helps if your data is set up in a tabular format, you can use the CurrentRegion command to capture everything in your dataset. The following example will use Offset to exclude the headings as we will assume they are in the file you are copying to.


Option Explicit
Sub OpenImp2() 'Excel VBA to import data
Const sPath="C:\Test\" 'Change this Path to suit
Dim sFil As String
Dim owb As Workbook
Dim ws As Worksheet

Set ws=Sheet1 'Handy as you don't need to refer to the workbook you start from.
sFil=Dir(sPath & "*.xl*") 'Flexible enough to handle all XL file types

Do While sFil <> "" 'Only Current Region excluding the Headers to the Last used Row in the WB.
Set owb=Workbooks.Open(sPath & sFil)
[A1].CurrentRegion.Offset(1).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
owb.Close False 'Close no save
sFil=Dir
Loop
End Sub


Open Workbooks in a Directory Import a Non Continuous Range

Occasionally you may need to import all of the inforamation which is not continuous, there are a number of ways to do this. One of them is to use a Union Range. The following will import data from Columns A to C and from F to K. The key line is as follows.

In order to import all of the information in a particular file it helps if your data is set up in a tabular format, you can use the CurrentRegion command to capture everything in your dataset. The following example will use Offset to exclude the headings as we will assume they are in the file you are copying to.


Set rng=Union(Range("A2:C" & lr), Range("F2:K" & lr))

In order to import all of the information in a particular file it helps if your data is set up in a tabular format, you can use the CurrentRegion command to capture everything in your dataset. The following example will use Offset to exclude the headings as we will assume they are in the file you are copying to.


The following will open a file and import the above ranges.

Option Explicit

Sub OpenImp() 'Excel VBA to import data
Dim owb As Workbook
Dim sh As Worksheet
Dim lr As Long
Dim rng As Range
Set sh=Sheet2
Set owb=Workbooks.Open("C:\Users\HYMC\Excel\Test\book1.xlsx") '(Change to suit).

lr=Range("A" & Rows.Count).End(xlUp).Row
Set rng=Union(Range("A2:C" & lr), Range("F2:K" & lr))
rng.Copy sh.Range("A" & Rows.Count).End(xlUp)(2)
owb.Close False 'Close opened workbook don't save
End Sub


This can be extended with further ranges as follows;

Set rng=Union(Range("A2:C" & lr), Range("F2:K" & lr),Range("M2:P" & lr))

Where the Columns M to P are added to the Union. This is a very handy tool to be able to employ when you only want certain Columns to be imported.


Open Workbooks in a Directory which Start with...

If you wanted to exclude certain files in the directory you can use the Wildcard Character (*) to assist with this. In the examples above the wildard character is used to import all Excel file types but you can narrow the files which are imported with the wildcard as well. Look at the example below with the wildcard in the Excel file name.

Option Explicit
Sub OpenImp2() 'Excel VBA to import data which starts with Total.
Const sPath="C:\Test\" 'Change to suit
Dim sFil As String
Dim owb As Workbook
Dim ws As Worksheet

Set ws=Sheet1 'Handy as you don't need to refer to the workbook you start from.
sFil=Dir(sPath & "Total*.xl*") 'Only Open files with beginning with Total

Do While sFil <> "" 'Only Current Region excluding the Headers to the Last used Row in the WB.
Set owb=Workbooks.Open(sPath & sFil)
[A1].CurrentRegion.Offset(1).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
owb.Close False 'Close no save
sFil=Dir
Loop
End Sub


Now the only difference is this line

    sFil=Dir(sPath & "Total*.xl*") 'Only Open files with beginning with Total

So if the Excel file in the C Test directory starts with the word Total, the procedue will open the workbook.


Export Data to Individual Files

The following procedure will make a fresh file (Child) from all of the data in the (Parent) file. Unique data is extracted from a Range and this is then used as criteria in the Autofilter. The results are then copied and pasted in a new file and the file is saved and closed in a directory of your choice. It is handy for month end batch reporting when each department or business unit wants an individual report. It enables the small datasets to be sent to each of the relevant departments while the master dataset is held in the hands of an administrator.

Option Explicit
Sub SavetoWB() 'Excel VBA to export data
Const sPath ="C:\Test\"
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook

Application.ScreenUpdating=False

Range("B1", Range("B" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [F1], True
ar=Range("F2", Range("F" & Rows.Count).End(xlUp))

'Loop through all unique instances of the Results from the Advanced Filter.
For i=LBound(ar) To UBound(ar)
Range("B1", Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
Range("A1", Range("F" & Rows.Count).End(xlUp)).Copy 'Where Data is from Col A - F
Set owb=Workbooks.Add
owb.Sheets(1).[A1].PasteSpecial xlPasteValues
owb.SaveAs sPath & [B2]
owb.Close False 'Close new workbook and do not save it was saved in the prior line.
Next i

Columns(5).EntireColumn.Clear
Application.CutCopyMode=0
[B1].AutoFilterMode=False

End Sub


The above just places the values from the Parent Workbook into Child workbooks it then saves the files with the relevant name and closes the file.


Open Workbooks in a Directory Import Specific Data

The opposite of Exporting data from a parent file is to import data from a directory into the file you are currently using. The following will open all of the files in a specific directory and import the information into the current file.

Option Explicit

Sub OpenImp3() 'Excel VBA to import data
Const sPath="C:\Test\" 'Change to suit
Dim sFil As String
Dim owb As Workbook
Dim ws As Worksheet
Dim lr as long

Set ws=Sheet1 'Handy as you don't need to refer to the workbook you start from
sFil=Dir(sPath & "*.xl*") 'Flexible enough to handle all XL file types

Do While sFil <> "" 'Only Copies Cols A to F.
Set owb=Workbooks.Open(sPath & sFil)
Range("A1", Range("F" & Rows.Count).End(xlUp)).AutoFilter 1, "England"
lr=Range("F" & Rows.Count).End(xlUp).Row
If lr > 1 Then Range("A2", Range("F" & Rows.Count).End(xlUp)).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
owb.Close False 'Close no save
sFil=Dir

Loop
End Sub


I have highlighted the term England in purple to highlight its importance. This is the criteria which will be filtered and there is an error trapping device after this point. The last used row (lr) after the Autofilter is applied is applied to see if there was anything in the file which was tagged as England. If there is nothing in Column A filtered as England the file will close. Otherwise the data will be copied to the Parent workbook and then the file Child file will close.