Copying worksheets from multiple workbooks into current workbook

Question

Copying worksheets from multiple workbooks into current workbook

Hi I was wondering if anybody if you guys could help me out?

Im trying to copy multiple workbooks and just save it into only one worksheet. I have 2000 diffrent workbooks with the diffrent amount of rows, The ammount of cells is the same and it dosent change and they are all at the first sheet in every workbook.

Im new with this kind of stuff so i'm thankfull for all help u can offer, I cant make it work. I'm using excel 2010

This is what I got atm:

Sub LoopThroughDirectory()
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 

    Filepath = “C:\test\” 
    MyFile = Dir("test\") 

    Do While Len(MyFile) > 0 
        If MyFile = "master.xlsm" Then
            Exit Sub 
        End If
        Range(Range("a1"), ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Name = "PivotData" 
        Workbooks.Open (Filepath & MyFile)
        Range("A2:AD20").Copy 
        ActiveWorkbook.Close 
        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))
        MyFile = Dir 
    Loop End
Sub 

Solution 1

Try this out:

Option Explicit
Sub CombineDataFiles()

Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
    LastDataRow As Long, LastDataCol As Long, _
    HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range

'initialize constants
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1

'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
    MsgBox ("Too many files selected, please pick more than " & MaxNumberFiles & ". Exiting sub...")
    Exit Sub
End If

'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)

'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count

    'open the file and assign the workbook/worksheet
    Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
    Set DataSheet = DataBook.ActiveSheet

    'identify row/column boundaries
    LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    'if this is the first go-round, include the header
    If FileIdx = 1 Then
        Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
    'if this is NOT the first go-round, then skip the header
    Else
        Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
    End If

    'copy the data to the outbook
    DataRng.Copy OutRng

    'close the data book without saving
    DataBook.Close False

    'update the last outbook row
    LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Next FileIdx

'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")

End Sub

Solution 2

I've re-written your code by applying what I posted in the comment.
Try this out: (I stick with your logic using the DIR function)

Sub test()

    Dim MyFile As String, MyFiles As String, FilePath As String
    Dim erow As Long
    '~~> Put additional variable declaration
    Dim wbMaster As Workbook, wbTemp As Workbook
    Dim wsMaster As Worksheet, wsTemp As Worksheet

    FilePath = "C:\test\"
    MyFiles = "C:\test\*.xlsx"
    MyFile = Dir(MyFiles)

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    '~~> Set your declared variables
    Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook
    Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit

    Do While Len(MyFile) > 0
        'Debug.Print MyFile
        If MyFile <> "master.xlsm" Then
            '~~> Open the file and at the same time, set your variable
            Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
            Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet
            '~~> Now directly work on your object
            With wsMaster
                erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row
                '~~> Copy from the file you opened
                wsTemp.Range("A2:AD20").Copy 'you said this is fixed as well
                '~~> Paste on your master sheet
                .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
            End With
            '~~> Close the opened file
            wbTemp.Close False 'set to false, because we opened it as read-only
            Set wsTemp = Nothing
            Set wbTemp = Nothing
        End If
        '~~> Load the new file
        MyFile = Dir
    Loop

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

I've commented the code to help you modify it to suit your needs.
I you got stuck again, then just go back here and clearly state your problem.

Comments

[user3430194]

This worked perfectly thank you guys for the feedback! Dan it's only to edit the number of files by changing the 2000 to xxxxx? thank you all! is their anyway to make this to loop faster? i have a loot files i have to this on

[Dan Wagner]

hey @user3430194, you can edit the maximum allowed files by changing the variable MaxNumberFiles to whatever number you'd like. i'm not sure about further optimizing the script for speed: the loop itself is pretty fast, but since your data exists in many places i think the bottleneck is going to be the opening/closing of each data file

[user3430194]

And what should i change in this code if i would want to select a whole folder insted of eatch one of them one by one

[Dan Wagner]

hey @user3430194, the script is set up for multi-select, so if you navigate to the directory of interest you should be able to select all the files with keyboard shortcut ctrl + a

[Dan Wagner]

hey @L42, this is good stuff that I'd do well to learn. Thanks for the code!

[user3430194]

is this one better then the one before.. sorry but im kind of still on the beginner level with this kind of work..

[user3430194]

btw im getting could u perhaps otherwise help me out with the commment i left on the previus commant that was made by Dan wagner

[L42]

@user3430194 I don't get your comment :) What help do you need?