Import content from separate Excel files to a single spreadsheet?

Hi everyone,

I've got several Excel files that need to be edited separately.
Once they have been edited, I need to paste the content of each file in a single separate Excel file.

Is there a way to retrieve the content from all the files in a folder, and merge it in a single file?

For example:
3 separate files > File1, File2, File3

Merged file, sheet1
File1
File2
File3

I'd really appreciate any help.

Hi paokun
A good place to start is with workbook by ravishankar
http://www.excelforum.com/attachment...eet-nimrod.xls

Hi pike,

Wow, this is a great macro!
Thanks, it does the job pretty neatly.

Now, starting from this sheet, how can I import only the visible cells?

If that's not possible, being able to import only specific columns would already help.

hey paokun
try something like this as its easier to follow and change

Sub ptest()
    Dim wbIn As Worksheet, shtOutOne As Worksheet, shtOutTwo As Worksheet
    Set wbIn = ThisWorkbook.Worksheets(2)
    Set shtOutOne = Workbooks.Open("C:\Documents and Settings\User\My Documents\New Folder\ptest1.xls").Worksheets(3)
    Set shtOutTwo = Workbooks.Open("C:\Documents and Settings\User\My Documents\New Folder\ptest2.xls").Worksheets(3)
    shtOutOne.Range("A1").CurrentRegion.Copy Destination:=wbIn.Range("A1")
    shtOutTwo.Range("A1").CurrentRegion.Copy Destination:=wbIn.Range("A" & wbIn.Cells(Rows.Count, 1).End(xlUp).Row + 1)
    Set wbIn = Nothing
    Set shtOutOne = Nothing
    Set shtOutTwo = Nothing
End Sub

Hi paokun

have a look at the code in this one

Pike, Paokun,

This variation on Pike's macro allows you to expand/contract the # of files in question by only editing one line of code...marked in red. Just add more filenames.

Option Explicit

Sub ptest()
Dim wbIn As Worksheet, i As Long, MyFiles
Set wbIn = ThisWorkbook.Worksheets(1)

MyFiles = Array("File1.xls", "File2.xls")

For i = LBound(MyFiles) To UBound(MyFiles)
    Workbooks.Open (ThisWorkbook.Path & "/" & MyFiles(i))
    Worksheets(1).Range("A1").CurrentRegion.Copy Destination:=wbIn.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ActiveWorkbook.Close False
Next

Set wbIn = Nothing
End Sub

How/Where to install the macro:

1. Open up your workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save your sheet

The macro is installed and ready to use. Press Alt-F8 and select it from the macro list.

Sorry, that was supposed to be an "/" not a "]".

If you want to:

1) Open all the files in a single folder and import them into a single sheet, data stacked
2) Close the imported files

I have a standard macro for that, you won't have to list the files, just set the correct path.

What's the range of data or column(s) you want to import?
What's the path to the folder?
Are all the files named similarly? Or should we just import everything in that folder regardless of name?

Here's the standard macro. I've highlighted the sections you would need to edit to suit your needs.

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Sheets("Master").Activate   'sheet report is built into, edit as needed
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.Clear
        NR = 1
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir     'memorizes your current working path
    fPath = "C:\My Documents\ExcelFiles"      'files are here
    fPathDone = "C:\My Documents\ExcelFiles\Imported"     'move files to here after import
    ChDir fPath
    fName = Dir("*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        Set wbkOld = Workbooks.Open(fName)      'Open file
        LR = Range("F" & Rows.Count).End(xlUp).Row  'Find last row and copy data edit range to suit
        Range("A1:A" & LR).EntireRow.Copy _
            wbkNew.Sheets("Master").Range("A" & NR)
        wbkOld.Close True   'close file
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1  'Next row
        Name fPath & fName As fPathDone & fName     'move file to "imported" folder
        fName = Dir     'ready next filename
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ChDir OldDir    'restores your original working path
End Sub

Hmm, just read your answers, always more features needed than originally thought...

Originally Posted by paokun

1) Open all the files in a single folder and import them into a single sheet, data stacked
Yes, basically I just put the macro file in the folder and would like to import all the files in this folder. If the macro file needs to be put in a separate folder, then I'd like to import the files that are in: C:\Project1\

You can edit that import path, yes?
I would put the macro file in a separate folder...

2) Close the imported files
Yes, that would be better.

Already does that...

3) I'd like to import columns F M N O and exclude the header line 2 in each file.

Um...FMNO should land in columns ABCD?
Rows3---> bottom of the data? That part is already highlighted, you can edit that...

4) I'd like to have the filename and worksheet appear in the export file so that I know where the text comes from.

Listed where? Think of everything I might as next in regard to this item and include a complete explanation of the output requirements. (nudge)

The four columns above are the only visible columns, all the rest is hidden. Still, probably it's more complicated to have the macro import only the visible text, is that why you asked for the range of cells?

Nah, it's equally cumbersome or equally simple...depends on your comfort level.

Copying all the visible data only, that could be helpful, yes indeed.

Originally Posted by paokun

Ops sorry I was replying to your message then I saw the macro.
Can you edit the macro based on the info I wrote above?

Why don't you take a whack at that, it will help you understand the code if you give it a shot.

Originally Posted by paokun

Using the last code that you pasted, I'm having some problems in defining the range, so I can still import only the first row.
Range("A1:A" & LR).EntireRow.Copy

How shall I write that I need rows FMNO?

Um...are you saying you ONLY want row1? Or that you want all the visible rows? I'm getting confused here.

Row1 only:

Range("F1:O1").SpecialCells(xlCellTypeVisible).Copy _
            wbkNew.Sheets("Master").Range("A" & NR)

All rows of visible data:

Range("F1:O" & LR).SpecialCells(xlCellTypeVisible).Copy _
            wbkNew.Sheets("Master").Range("A" & NR)

As for the filename, currently it only shows ABC_OUTPUT, and I can't see the correct filename in the green cell. Also, some worksheets have Japanese names and won't be displayed.

Huh? You know I'm not sitting in the room with you, so I can't see things like "green cells" and Japanese anything.

Here you go...and you should know, uploading the sample file and sample results doc made this simple SIMPLE to understand. A picture is worth a 1000 words!

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       2/4/2010     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet, wsNew As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Set wsNew = wbkNew.Sheets("Sheet1")
    wsNew.Activate   'sheet report is built into, edit as needed
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.Clear
        NR = 1
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir                         'memorizes your current working path
    fPath = "C:\Project1\"                  'files are here
    fPathDone = "C:\Project1\Imported\"      'move files to here after import
    ChDir fPath
    fName = Dir("*.xls")                    'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        Set wbkOld = Workbooks.Open(fName)      'Open file
            For Each ws In ActiveWorkbook.Worksheets
                With wsNew
                    .Range("A" & NR).Value = fName
                    .Range("B" & NR) = "Worksheet: " & ws.Name
                    .Range("A" & NR, "D" & NR).Interior.ColorIndex = 43
                    LR = ws.Range("F" & Rows.Count).End(xlUp).Row  'Find last row and copy data edit range to suit
                    ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy
                    .Range("A" & NR + 1).PasteSpecial xlPasteAll
                    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
                    End With
            Next ws
        wbkOld.Close False   'close file
        Name fPath & fName As fPathDone & fName     'move file to "imported" folder
        fName = Dir     'ready next filename
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ChDir OldDir    'restores your original working path
End Sub

Put this macro into your RESULTS workbook. Don't save that workbook in the same folder as your Project1 files. Also, make sure there is a folder called IMPORTED inside the Project1 folder, the macro will try to move the imported files into there as it goes.

1) The macro goes in a regular module (module1, module2, etc)
2) What is the fPath folder name? Did you edit it? Check the spelling...it must be exactly right and end with \.
3) Did you create the Imported folder inside that fPath folder?

Try going into the VBeditor and using F8 on the macro to step through it one line at a time....keep pressing F8. When you pass the fName = Dir line of code, put your mouse over the fName variable...what value pops up? File1.xls?

Did you do this?

Originally Posted by JBeaucaire

Try going into the VBeditor and using F8 on the macro to step through it one line at a time....keep pressing F8. When you pass the fName = Dir line of code, put your mouse over the fName variable...what value pops up? File1.xls?

It appears there is an error in the location of the files and the path, and perhaps the filenames. I just ran the macro again on my own desktop folder and it pulled in all the files in there...

I know it probably doesn't matter, but make the XLS into lowercase xls as shown in the original macro.

Just for chuckles, you could change it *.* instead of *.xls just to see if the macro can see anything.

There's no reason at all you should be getting the first row from the source files.

Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy

...we don't even include row1 in the copy command.

The only difference in the macro I tested on my system and the one I uploaded is the path to my files was "C:\Test1\"... everything else is identical.

I put 3 different copies of your File1 in there with different names. Works great. I can't fathom your different results. I would be spending time running the code with F8 (one line of code at a time) so I could switch back and forth between the editor and the workbook, try to see what's failing at the copy part.

I suppose you could change this, though I didn't need to:

LR = ws.Range("F" & Rows.Count).End(xlUp).Row

It WORKED!!!

This is wonderful programming, you're a genius!

Now, the only problem left is that if a file has several worksheets, it cannot import them correctly.
Basically it separates them well, but it always only import the text of the active visible worksheet (basically the one shown when you open the file).

Do you know how to copy the text contained in each single worksheet inside a file?

Originally Posted by paokun

Now, the only problem left is that if a file has several worksheets, it cannot import them correctly.

Oops. Well, that's what happens when you oversimplify the sample data, every sample sheet had the same fake data, so I didn't spot the programming error sooner. Sorry about that.

One tiny change:

ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy

Also, change this...

        wbkOld.Close False   'close file

Hi JBeaucaire,

Back to the forum.
I've spent a few days working with the script you created, and I have a few tweaks to ask you:

1. If, among the visible cells, there's a full row without text, the script would stop importing there, even if below it there's some cell with text. Is it possible to import all un-hidden cells (or a range of rows), even if there are empty rows in between?

2. Rather than having the filename and worksheet in one single row, would it be possible to have the filename on Column A, worksheet name on Column B, and the imported text starting from Column C?
For example:

Filename1 - Sheet1 - Imported text
Filename1 - Sheet1 - Imported text
Filename1 - Sheet2 - Imported text
Filename2 - Sheet1 - Imported text

This way it would be possible to filter the imported cells via filename and worksheet, and I wouldn't need any green line separating them.

I don't know if you can still check these two issues, but that would be really appreciated.
Please let me know if you have any question, and thanks again for your help.

Originally Posted by paokun

1. If, among the visible cells, there's a full row without text, the script would stop importing there, even if below it there's some cell with text. Is it possible to import all un-hidden cells (or a range of rows), even if there are empty rows in between?

That's not correct. The code isn't importing like that. It's spotting the

LR = ws.Range("F" & Rows.Count).End(xlUp).Row  'Find last row and copy data edit range to suit
ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy

These lines of code read:
Find the last row of data by looking UP from the bottom of column F. Blanks within the data do not effect this spotting process.
Then copy all visible rows of data from row2 down thru the spotted bottom row.

The only way data would be missed is if we've chosen the wrong column to look up in.

Recheck that, F8 your way through the macro and when it gets to that part of the code, see what value is going into LR and then see if that doesn't cover the range.

Originally Posted by paokun

Yep, the line LR = ws.Range("F" & Rows.Count) imports everything in column F even if there are empty cells in between.

Nope...I realize you're having an issue and we'll work through it, but we need to clarify what each line of code does. The line of code you cited above doesn't import anything. It serves only to find the bottom row of data.

LR = ws.Range("F" & Rows.Count).End(xlUp).Row   'Find last row and copy data edit range to suit
ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy

The second line of code does the actual copy job and it only copies visible data. So nothing hidden should be seen. The sample files you gave earlier this code worked fine on, so if there is some significant difference, perhaps we should look at the new files you're trying.

However, if the last cell with text in column F is F30, and I have some text in M35, M35 won't be imported, it will only go as far as M30.

Ah, is this the real issue? Spotting the bottom row properly is a pain sometimes. Most of my sheets, the first column (column A) always has something in it for every row of data, you don't have a key column like that on your worksheet? Also, having stuff hidden makes that a little trickier if the key column is hidden too.

Try this, your mileage may be better:

LR = ws.Range("A1").SpecialCells(xlCellTypeLastCell).Row        'Find last row
ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy      'copy data, edit range to suit

No, the syntax is correct and it worked for me. Are the sheets you're testing now notably different?

Please try with this sample attached, importing all yellow cells until line 36 would be ideal.
As I said, now they get imported correctly, but the next filename+worksheet green line is displayed after F31, rather than after N36.

(Please ignore the white cells with the text 'ToImport': only the yellow un-hidden cells need to get imported)

Hehe, yep, significantly different. OK. So the visible columns to import are F,M,N and O. We need to check EACH column and use the column with the deepest value for the LR variable.

We need to do the same thing on the import sheet, too.

Try these changes, updates marked in red:

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       2/11/2010     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet, wsNew As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Set wsNew = wbkNew.Sheets("Sheet1")
    wsNew.Activate   'sheet report is built into, edit as needed
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.Clear
        NR = 1
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir                         'memorizes your current working path
    fPath = "C:\Project1\"                  'files are here
    fPathDone = "C:\Project1\Imported\"      'move files to here after import
    ChDir fPath
    fName = Dir("*.xls")                    'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        Set wbkOld = Workbooks.Open(fName)      'Open file
            For Each ws In ActiveWorkbook.Worksheets
                With wsNew
                    .Range("A" & NR).Value = fName
                    .Range("B" & NR) = "Worksheet: " & ws.Name
                    .Range("A" & NR, "D" & NR).Interior.ColorIndex = 43
                    LR = Application.WorksheetFunction.Max( _
                        ws.Range("F" & Rows.Count).End(xlUp).Row, _
                            ws.Range("M" & Rows.Count).End(xlUp).Row, _
                                ws.Range("N" & Rows.Count).End(xlUp).Row, _
                                    ws.Range("O" & Rows.Count).End(xlUp).Row)   'Find last row and copy data edit range to suit
                    ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy
                    .Range("A" & NR + 1).PasteSpecial xlPasteAll
                    NR = Application.WorksheetFunction.Max( _
                        .Range("A" & .Rows.Count).End(xlUp).Row, _
                            .Range("B" & .Rows.Count).End(xlUp).Row, _
                                .Range("C" & .Rows.Count).End(xlUp).Row, _
                                    .Range("D" & .Rows.Count).End(xlUp).Row) + 1   'Next row
                    End With
            Next ws
        wbkOld.Close False   'close file
        Name fPath & fName As fPathDone & fName     'move file to "imported" folder
        fName = Dir     'ready next filename
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ChDir OldDir    'restores your original working path
End Sub

Try this:

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       2/11/2010     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet, wsNew As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Set wsNew = wbkNew.Sheets("Sheet1")
    wsNew.Activate   'sheet report is built into, edit as needed
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.clear
        NR = 1
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir                         'memorizes your current working path
    fPath = "C:\Project1\"                  'files are here
    fPathDone = "C:\Project1\Imported\"      'move files to here after import
    ChDir fPath
    fName = Dir("*.xls")                    'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        Set wbkOld = Workbooks.Open(fName)      'Open file
            For Each ws In ActiveWorkbook.Worksheets
                With wsNew
                    .Range("A" & NR).Value = fName
                    .Range("B" & NR) = "Worksheet: " & ws.Name
                    LR = Application.WorksheetFunction.Max( _
                        ws.Range("F" & Rows.Count).End(xlUp).Row, _
                            ws.Range("M" & Rows.Count).End(xlUp).Row, _
                                ws.Range("N" & Rows.Count).End(xlUp).Row, _
                                    ws.Range("O" & Rows.Count).End(xlUp).Row)   'Find last row and copy data edit range to suit
                    ws.Range("F2:O" & LR).SpecialCells(xlCellTypeVisible).Copy
                    .Range("C" & NR).PasteSpecial xlPasteAll
                    LR = NR
                    NR = Application.WorksheetFunction.Max( _
                        .Range("A" & .Rows.Count).End(xlUp).Row, _
                            .Range("B" & .Rows.Count).End(xlUp).Row, _
                                .Range("C" & .Rows.Count).End(xlUp).Row, _
                                    .Range("D" & .Rows.Count).End(xlUp).Row) + 1   'Next row
                    .Range("A" & LR, "B" & LR).AutoFill .Range("A" & LR, "B" & NR - 1)
                    End With
            Next ws
        wbkOld.Close False   'close file
        Name fPath & fName As fPathDone & fName     'move file to "imported" folder
        fName = Dir     'ready next filename
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ChDir OldDir    'restores your original working path
End Sub

Try this:

.Range("A" & LR, "B" & LR).Copy .Range("A" & LR + 1, "B" & NR - 1)