Import data from multiple workbooks

 2011-10-26    Import & Export    0    114

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


Leave a comment:

Your comment will only be published after it has been moderated and found spam free.
Your e-mail address will only be used to display your Gravatar.