Import data from multiple workbooks
2011-10-26 Import & Export 5 417
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 SubThe 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 FunctionThe 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 FunctionFinally, 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