Merging same format table from several spreadsheets into one

[Jaffabfc]

Hi,

I have in a folder around 2-300 spreadsheets that i am wanting to merge into one.
They are all setup with the exact same titles but i am wanting to merge them all into one.

With an added column.
So at the moment cells B2:Q2 are all the exact same in every spreadsheet, i am wanting to merge them all but an added column (maybe A starting at A2) and calling it the name of the spreadsheet its been pulled from.

If this possible? ideally without a bit of SQL, but if it has to be then thats fine.

Thanks

 

[Jaffabfc]

Done that and it seems to have worked, although there are several tabs on each of the spreadsheet and its brought the first tab (which it obviously would) i need it to pick the 2nd tab called Unpickable.

How can i add that in, other than that it seems to be working just how i want it thankyou

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
    Set desWS = ThisWorkbook.Sheets(1)
    Const strPath As String = "C:\Users\carlbow\Desktop\Non Pickable\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsb")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("Unpickable")
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("B2:Q" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0)
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow - 1) = srcWB.Name
        End With
        srcWB.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Jaffabfc]

Thanks i managed to sort it, but got an error as there was too much data which i wasnt expecting so i will have to do in smaller chunks i think.
thanks for your help

 

[mumps]

You are very welcome.

 

[Jaffabfc]

Sorry to come back to you on this.

I am trying to edit the code to use on a different load of sheets.
The sheets are from A:M but when i copy them over i want Column N to show the the file name.
How would i change this?

 

[RoryA]

FWIW you could do this with PowerQuery using the Get Data from folder option.

 

[Jaffabfc]

i tried that but i dont know how to merge the data on the files

 

[RoryA]

What exactly did you try? (that's literally all that function does )

There are numerous examples of how it works, eg:

Import data from a folder with multiple files (Power Query) - Microsoft Support

Use Excel's Get & Transform (Power Query) experience to combine multiple files, which have the same schema, from a single folder into a single table.

support.microsoft.com

Get data from folder in Power Query: combine files quickly

Covers 2 ways to get data from a folder using Power Query. One of the biggest time saves for Excel users is the ability to combine files quickly.

exceloffthegrid.com

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
    Set desWS = ThisWorkbook.Sheets(1)
    Const strPath As String = "C:\Users\carlbow\Desktop\Non Pickable\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsb")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("Unpickable")
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A2:M" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            desWS.Cells(desWS.Rows.Count, "N").End(xlUp).Offset(1, 0).Resize(LastRow - 1) = srcWB.Name
        End With
        srcWB.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Jaffabfc]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
    Set desWS = ThisWorkbook.Sheets(1)
    Const strPath As String = "C:\Users\carlbow\Desktop\Non Pickable\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsb")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("Unpickable")
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A2:M" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            desWS.Cells(desWS.Rows.Count, "N").End(xlUp).Offset(1, 0).Resize(LastRow - 1) = srcWB.Name
        End With
        srcWB.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Hi,

No that doesnt seem to be working