Import data from multiple workbooks
2011-10-26 Import & Export 5 450
Time to upgrade an old popular code example, this time as a more complete example almost ready to use. You will still have to make a few decisions about what you actually want to import. But most of the work is done, so enjoy! Below is the main macro that will do most of the work. It takes 2 input arguments, the worksheet where you want to store the imported data and an array of workbook filenames that you want to import data from.
Sub CopyDataFromMultipleWorkbooks(wsTarget As Worksheet, varWorkbooks As Variant)
Dim i As Long, lngSuccess As Long, lngFailed As Long
If wsTarget Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False
.Cursor = xlWait
End With
lngSuccess = 0
lngFailed = 0
If IsArray(varWorkbooks) Then
For i = LBound(varWorkbooks) To UBound(varWorkbooks)
Application.StatusBar = "Copying data from " & CStr(varWorkbooks(i))
If CopyDataFromWB(wsTarget, CStr(varWorkbooks(i)), i = LBound(varWorkbooks)) Then
lngSuccess = lngSuccess + 1
Else
lngFailed = lngFailed + 1
End If
Next i
Else ' one single workbook
Application.StatusBar = "Copying data from " & varWorkbooks
If CopyDataFromWB(wsTarget, CStr(varWorkbooks), True) Then
lngSuccess = lngSuccess + 1
Else
lngFailed = lngFailed + 1
End If
End If
With wsTarget
.Parent.Activate
.Activate
.Range("A1").Select
End With
With Application
.StatusBar = False
.Cursor = xlDefault
.ScreenUpdating = True
End With
MsgBox "Workbooks copied: " & lngSuccess & vbLf & _
"Workbooks failed: " & lngFailed, vbInformation
End Sub
The function below will copy data from a specific workbook to your target worksheet. You will need to edit this function to tell it what worksheets you want to import data from, in the example below it will only copy data from the first worksheet in the workbook, but it is easy to change this to something else.
Function CopyDataFromWB(wsTarget As Worksheet, strSource As String, blnFirstWB As Boolean) As Boolean
' customize this function for each import task
Dim i As Long, wb As Workbook, strName As String, blnWasOpen As Boolean, ws As Worksheet
CopyDataFromWB = False
If wsTarget Is Nothing Then Exit Function ' no target worksheet
If blnFirstWB Then ' prepare wsTarget for new data
With wsTarget
If .FilterMode Then .ShowAllData ' reset any filtered data
.Cells.Clear ' clear all existing data in wsTarget
'.Range("A1:Z" & .Rows.Count).Clear ' clear existing data in wsTarget
End With
End If
If Len(strSource) < 6 Then Exit Function ' not a valid file path
' find the last path separator character
i = InStrRev(strSource, Application.PathSeparator)
If i = 0 Then
i = InStrRev(strSource, "/") ' just in case it is an Internet path
End If
If i = 0 Then Exit Function ' not a valid file path
' extract the filename only from the filepath
strName = Mid(strSource, i + 1)
' check if the workbook is already open
blnWasOpen = True
On Error Resume Next
Set wb = Workbooks(strName)
If wb Is Nothing Then
' open the workbook as read only, no link updates
Application.StatusBar = "Opening workbook: " & strName & "..."
blnWasOpen = False
Set wb = Workbooks.Open(strSource, False, True)
End If
On Error GoTo 0
If Not wb Is Nothing Then ' copy data from the workbook
i = 0
With wb
Application.StatusBar = "Copying data from " & .Name & "..."
' copy data from a worksheet by number
If CopyDataFromWS(wsTarget, Worksheets(1), True) Then
i = i + 1 ' count successful copies
End If
' copy data from a worksheet by name
'If CopyDataFromWS(wsTarget, Worksheets("Sheet1"), True) Then
' i = i + 1 ' count successful copies
'End If
' copy data from all worksheets
'For Each ws In .Worksheets
' ' check if the worksheet is a valid data source
' If ws.Range("A1").Value = wsTarget.Range("A1").Value Then
' If CopyDataFromWS(wsTarget, ws, blnFirstWB) Then
' i = i + 1 ' count successful copies
' blnFirstWB = False
' End If
' End If
'Next ws
'Set ws = Nothing
' return true if data was copied from one or more worksheets
CopyDataFromWB = i > 0
If Not blnWasOpen Then ' close the workbook
.Close False ' don't save any changes
End If
End With
Set wb = Nothing
End If
Application.StatusBar = False
End Function
The function below will copy data from one worksheet to your target worksheet. You will have to customize this function to tell it what data range you want to import. In the example below all data in the worksheet will be copied.
Function CopyDataFromWS(wsTarget As Worksheet, wsSource As Worksheet, blnInclHeader As Boolean) As Boolean
' customize this function for each import task
Dim lngTargetRow As Long, lrn As Long, lcn As Long
CopyDataFromWS = False
If wsTarget Is Nothing Then Exit Function
If wsSource Is Nothing Then Exit Function
If blnInclHeader Then
' copy header row from wsSource to wsTarget
wsSource.Rows(1).Copy
wsTarget.Range("A1").PasteSpecial xlPasteValues ' paste values only
Application.CutCopyMode = False
End If
With wsTarget
' determine the target row
lngTargetRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
With wsSource
' copy data from wsSource
If .FilterMode Then .ShowAllData
' determine the data range to copy
lrn = .Range("A" & .Rows.Count).End(xlUp).Row ' last row
lcn = .Cells(1, .Columns.Count).End(xlToLeft).Column ' last column
.Range(.Cells(2, 1), .Cells(lrn, lcn)).Copy
wsTarget.Range("A" & lngTargetRow).PasteSpecial xlPasteValues ' paste values only
Application.CutCopyMode = False
End With
CopyDataFromWS = True
End Function
Finally, here is an example on how to use the macros above:
Sub ImportDataFromMultipleWorkbooks()
Dim varWorkbooks As Variant
varWorkbooks = "Excel Workbooks (*.xl*),*.xl*,All Files (*.*),*.*"
varWorkbooks = Application.GetOpenFilename(varWorkbooks, 1, "Select one or more workbooks:", , True)
If Not IsArray(varWorkbooks) Then Exit Sub ' the user cancelled the dialog
CopyDataFromMultipleWorkbooks ThisWorkbook.Worksheets(1), varWorkbooks
End Sub