Consolidate 2 sheets from 2 workbooks

[Nigel]

I have 2 workbooks,

Workbook1, Workbook2

Both workbooks have a sheet of data.

I want to copy the data from my sheet of data in Workbook1 and paste it under the data the sheet of data in Workbook2 ( excluding headings).

Can anybody help me out here?

 

[Nigel]

this has to be done with macro by the way

 

[Marc L]

​

By the way, this could be done by the Macro Recorder to begin with a basis code …​

 

[SirJB7]

Hi, Nigel!
What about this?
- open both workbooks
- activate 1st workbook
- select proper worksheet
- select row of 1st cell after headings
- press Shift + End + Down arrow
- press Ctrl-C
- activate 2nd workbook
- select proper worksheet
- click on 1st cell on 1st data column
- press End + Down arrow
- click on the cell at next row column A
- press Ctrl-V
Regards!

 

[Raghu Ram Alla]

Hello Nigel,

Probably you can use the below code to consolidate all the workbooks with multiple work sheets

Sub ConsoldateMultipleWorkBooksIntoOne()
 
'#########################################################################################
'#########################################################################################
'Macro to Consolidate Multiple WorkBooks with Multiple WorkSheets to One main file
'The Main file is expected to have atleast two worksheets (considering for this file)
'and can be increased to any number, if more worksheets are needed to be consolidated
'we can loop through them, instead of coding for individual worksheets.
'No restricts in naming convention of file names or worksheets
'But all the worksheets in individual files are expected to be in same order
'Other wise consolidation may be a mess!!
'Credits: Part of the Macro is been captured from "Ozgrid" Community, Code by "Mr Patel"
'#########################################################################################
'#########################################################################################
 
    Dim StrFile, MyPath As String
    Dim objFSO, destRow As Long
    Dim mainFolder, mySubFolder
    Dim MyFiles(), DirArr() As String
    Dim FNum As Long
    Dim mybook As Workbook
    Dim BaseWks1 As Worksheet
    Dim CalcMode, rowCount, baseItemCount As Long
   
    'set files path to be merged using FSO
    FNum = 0
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    'Input file path
    MyPath = "C:\File Location"
   
    'Get all files in the given path
    Set mainFolder = objFSO.GetFolder(MyPath)
    StrFile = Dir(MyPath & "*.xl*")
       
    'set main worksheets with should have merged content
    Set BaseWks1 = ThisWorkbook.Worksheets(1)
    Set BaseWks2 = ThisWorkbook.Worksheets(2)
   
    'POPULATE MYFILES() ARRAY with FILES in the given FOLDER
    Do While Len(StrFile) > 0
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        ReDim Preserve DirArr(1 To FNum)
        MyFiles(FNum) = StrFile
        DirArr(FNum) = MyPath
        StrFile = Dir
    Loop
 
    'Disable autocalculation mode to reduce copy/refresh time, screen updating & events not to inturrept in between
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    'loop through each file in the directory to merge
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
           
            'get each file in the folder
            Set mybook = Workbooks.Open(DirArr(FNum) & "\" & MyFiles(FNum))
           
            On Error GoTo 0
            'copy first workseet
            baseItemCount1 = BaseWks1.Range("A1").CurrentRegion.Rows.Count 'get row count in sheet1
            mybook.Worksheets(1).Range("A1").CurrentRegion.Copy Destination:=BaseWks1.Range("A" & baseItemCount1 + 1)
           
            'copy second workseet
            baseItemCount2 = BaseWks2.Range("A1").CurrentRegion.Rows.Count 'get row count in sheet2
            mybook.Worksheets(2).Range("A1").CurrentRegion.Copy Destination:=BaseWks2.Range("A" & baseItemCount2 + 1)
           
            'close individual workbook with out saving any changes
            mybook.Close savechanges:=False
        Next FNum
    End If
   
ExitTheSub:
    ' Restore the application properties : Enable the options which we have disabled earlier
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
 
End Sub

Hope this helps