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

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
    Set desWS = ActiveWorkbook.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 = ActiveWorkbook.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

so i changed the code to the new folder path and the format is now xlsx that wouldnt make a difference would it?

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
    Set desWS = ActiveWorkbook.Sheets(1)
    Const strPath As String = "C:\Users\carlbow\Desktop\Pallets\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    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

its not accumulating all the sheets, its just opening up the first file in that folder with no ammendments.
nothing is appearing in column N


Thanks for you help as always though

 

[mumps]

Try replacing this line of code:

Set desWS = ActiveWorkbook.Sheets(1)

with this line:

Set desWS = ThisWorkbook.Sheets(1)

Then place the macro in a regular module in a blank workbook (not the personal workbook) and run it from there. See if it works.

so i changed the code to the new folder path and the format is now xlsx that wouldnt make a difference would it?

This should not make any difference.

 

[Jaffabfc]

Try replacing this line of code:

Set desWS = ActiveWorkbook.Sheets(1)

with this line:

Set desWS = ThisWorkbook.Sheets(1)

Then place the macro in a regular module in a blank workbook (not the personal workbook) and run it from there. See if it works.

This should not make any difference.

Hi,

Tried this too and made no difference just doesnt load anything

 

[mumps]

It worked for me. Do your files in that folder have "xlsx" extensions?

 

[Jaffabfc]

It worked for me. Do your files in that folder have "xlsx" extensions?

Yes all xlsx files, let me try it all again. every file as one tab called WHPallets_Stores_BBD that wont make any difference would it?

 

[mumps]

If that is the name of the sheet, then replace this line of code:

With srcWB.Sheets("Unpickable")

with this line:

With srcWB.Sheets("WHPallets_Stores_BBD")

 

[Jaffabfc]

Sorry i should have mentioned that at the beginning, that seems to be working now.

Much appreciated.

 

[mumps]

You are very welcome.