vbaexcelworksheethssfworkbook

Excel VBA: How to combine specific worksheets from different workbooks?


I am still very new to VBA and am trying to combine certain worksheets from different workbooks.

For example:

I want to take worksheet A from workbook One and worksheets F and G from workbook Two. I wish to put these different worksheets in a new workbook called "Three."

My fields in worksheets A and F are in the exact same format, so I also wish to combine these two worksheets and put F data in the same fields under the A data, as soon as my cells containing A data finishes.

Could anyone help me with this code??
If anyone also has any links to VBA for beginners that would be highly appreciated.


Solution

  • Take a look at example:

    'enforce declaration of variables 
    Option Explicit
    
    Sub CombineWorkbooks()
    Dim sWbkOne As String, sWbkTwo As String
    Dim wbkOne As Workbook, wbkTwo As Workbook, wbkThree As Workbook
    Dim wshSrc As Worksheet, wshDst As Worksheet
    
    On Error GoTo Err_CombineWorkbooks
    
    'get the path
    sWbkOne = GetWbkPath("Open workbook 'One'")
    sWbkTwo = GetWbkPath("Open workbook 'Two'")
    'in case of "Cancel"
    If sWbkOne = "" Or sWbkTwo = "" Then
        MsgBox "You have to open two workbooks to be able to continue...", vbInformation, "Information"
        GoTo Exit_CombineWorkbooks
    End If
    
    'open workbooks: 'One' and 'Two'
    Set wbkOne = Workbooks.Open(sWbkOne)
    Set wbkTwo = Workbooks.Open(sWbkTwo)
    'create new one - destination workbook
    Set wbkThree = Workbooks.Add
    
    'define destination worksheet
    Set wshDst = wbkThree.Worksheets(1)
    
    'start copying worksheets
    'A
    Set wshSrc = wbkOne.Worksheets("A")
    wshSrc.UsedRange.Copy wshDst.Range("A1")
    'F
    Set wshSrc = wbkTwo.Worksheets("F")
    wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
    'G
    Set wshSrc = wbkTwo.Worksheets("G")
    wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
    
    'done!
    
    Exit_CombineWorkbooks:
        On Error Resume Next
        Set wbkThree = Nothing
        If Not wbkTwo Is Nothing Then wbkTwo.Close SaveChanges:=False
        Set wbkTwo = Nothing
        If Not wbkOne Is Nothing Then wbkOne.Close SaveChanges:=False
        Set wbkOne = Nothing
        Set wshDst = Nothing
        Set wshSrc = Nothing
        Exit Sub
    
    Err_CombineWorkbooks:
        MsgBox Err.Description, vbExclamation, Err.Number
        Resume Exit_CombineWorkbooks
    
    
    End Sub
    
    
    Function GetWbkPath(ByVal initialTitle) As String
    Dim retVal As Variant
    
    retVal = Application.GetOpenFilename("Excel files(*.xlsx),*.xlsx", 0, initialTitle, , False)
    If CStr(retVal) = CStr(False) Then retVal = ""
    
    GetWbkPath = retVal
    
    End Function
    

    Note: Above code has been written ad-hoc, so it may not be perfect.

    [EDIT2] If you would like to copy data into different sheets, please, replace corresponding code with below, but firstly remove these lines:

    'define destination worksheet
    Set wshDst = wbkThree.Worksheets(1)
    

    later:

    'start copying data 
    'A
    Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
    wshDst.Name = "A"
    Set wshSrc = wbkOne.Worksheets("A")
    wshSrc.UsedRange.Copy wshDst.Range("A1")
    'F
    Set wshSrc = wbkTwo.Worksheets("F")
    Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
    wshDst.Name = "F"
    wshSrc.UsedRange.Copy wshDst.Range("A1")
    'G
    Set wshSrc = wbkTwo.Worksheets("G")
    Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
    wshDst.Name = "G"
    wshSrc.UsedRange.Copy wshDst.Range("A1")
    

    Good luck!