Consolidated Multiple workbooks into One - Query

[MaunishP]

Hi Team,
I already have a code which is able to consolidate multiple workbooks into one sheet, however it only copies data from 1st worksheet, but i want to copy all data from worksheet 2.

Naming structure for each workbooks for worksheet 2 will not be same.

Please help where i can consolidate data from each workbook only 2nd worksheet.


Here goes current code

Option Explicit
Sub OpenImp() 'Excel VBA to open and import data
   Const sPath = "M:\Maunish Project\test\" 'Change to suit
   Dim sFil As String
    Dim owb As Workbook
    Dim ws As Worksheet

    Set ws = Sheet1
    sFil = Dir(sPath & "*.xl*") 'Flexible enough to handle all XL file types
   Do While sFil <> "" 'Only Copies Cols B
       Set owb = Workbooks.Open(sPath & sFil)
        [A1:L30000].Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
        owb.Close False 'Close No need to save
       sFil = Dir
    Loop
End Sub

 

[Deepak]

If the name/sheet ref of 2nd worksheet is not identical then how the same will define to get data, however you would from below alternatives.

1.

owb.Sheet2.[A1:L30000].Copy ws.Range("A" & Rows.Count).End(xlUp)(2)

2.

owb.Sheets(2).[A1:L30000].Copy ws.Range("A" & Rows.Count).End(xlUp)(2)

3.

owb.Sheets("myname").[A1:L30000].Copy ws.Range("A" & Rows.Count).End(xlUp)(2)

 

[MaunishP]

Hi Deepak,
Thanks for differenet options however when used code 2. Data is getting overlapped where i dont want to have overlapped data, it should copy all information from each workbook and paste after the blank row. Above pasted code by me, copies all data available in sheet one and paste new data on new cell. It doesnt overlaps

 

[Deepak]

Hi Deepak,
Thanks for differenet options however when used code 2. Data is getting overlapped where i dont want to have overlapped data, it should copy all information from each workbook and paste after the blank row. Above pasted code by me, copies all data available in sheet one and paste new data on new cell. It doesnt overlaps

Check this...

owb.Sheets(2).[A1:L30000].Copy ws.Range("A" & ws.Rows.Count).End(xlUp)(2)