VBA Automatic Import of over 500 spreadsheets

[Fuisdale2]

Good afternoon,

I was wondering if anyone can advise if there is a piece of code within VBA that you can use to run to import any documents that are in a network location.

I have a project document which is the master document. As part of the process I need to bulk import over 500 spreadsheets into it to create a database.

However, clicking on each spreadsheet individually is going to be a never ending task.


There must be an easier way.

Any suggestions or ideas welcomed.

 

[tonyyy]

Fuisdale2,

The following assumes you can access your network location through a file dialog...

Sub AnotherMaster()
Application.ScreenUpdating = False
Dim wb As Workbook, wb1 As Workbook, wb2 As Workbook
Dim FolderName As String, fileName As String
Dim i As Long, NextRow As Long

''''Select folder that contains files
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = 0 Then Exit Sub
  FolderName = .SelectedItems(1) & "\"
End With

Set wb = ThisWorkbook 'workbook with this macro
Set wb1 = Workbooks.Add '"Master" workbook
fileName = Dir(FolderName & "*.xls?")

''''Loop through files
Do While fileName <> ""
    If fileName <> wb.Name And fileName <> wb1.Name Then
        Set wb2 = Workbooks.Open(FolderName & fileName) 'Each of the workbooks to be opened/copied
        ''''Loop through sheets
        For i = 1 To wb2.Worksheets.Count
            With wb1.Sheets(1)
                ''''Determine next blank row in wb1
                NextRow = .Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1
                ''''Copy each/every sheet in each workbook to the 'Master" workbook
                wb2.Sheets(i).UsedRange.Copy Destination:=.Cells(NextRow, 1)
            End With
        Next i
        wb2.Close savechanges:=False
    End If
    fileName = Dir
Loop
wb1.Sheets(1).Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

The code starts by presenting a file dialog, allowing you to select the folder in which your files reside.
Three references are established:
1. The workbook that contains this macro - wb.
2. A new (added) workbook that will be the "Master" - wb1.
3. Each of the workbooks to be opened/copied - wb2.
The code then loops through each workbook - and each worksheet in each workbook - and copies the sheet contents to Sheet1 in the "Master" workbook.

Cheers,

tonyyy

 

[VBA learner ITG]

Hi Tony,

I have tried your code and i am getting an Run time error 91.
Object variable or with workbook block variable not set.

this is the part of the code thats highlighted in de bugger.

NextRow = .Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1

 

[steve the fish]

You will get that error on an empty sheet.

 

[VBA learner ITG]

Hi Steve,

all the test sheets i have tried the code on has metadata in.

I tested on 3 separate spreadsheets.

1 with 1 line of data
1 with 132 lines of data
1 with 144 lines of data

 

[steve the fish]

From what i can see wb1 is created by the code. For that reason it must have blank sheets and the code will fail at the line you mentioned.

 

[VBA learner ITG]

Hi Steve,

excuse my ignorance.

Am i right in my understanding that when WB1 is created the data should be copied from wb2 into wb1 which is the master.

 

[steve the fish]

Yes thats what its doing but its trying to find the last used cell in the master. Unfortunately if the master is blank then the code used doesnt work. Try this as a replacement:

.Range("A1") = "Master"
NextRow = .Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1

As the master sheet now has a filled cell in it the code should run ok.

 

[VBA learner ITG]

Hi Steve,

Thank you for your input.

You have resolved the error that i was getting.



Hi Tonyyy,

Thank you for the piece of code to start off with.



You both have saved me hours of work.

 

[tonyyy]

@steve the fish - Thanks for stepping in and debugging.

VBA learner ITG - You're very welcome.