Merge Multiple Excel File adding Reference

[Portucale]

Hi,

I have seen great codes in different forums, but I can't figure out how can I include the source name, or, a string contained within a cell. Please see the example code which merges all workbooks within the same location, and in each workbook there is a sheet (Sheet1) with the week number in cell B2, so, how can I merge the workbooks and at the same time add the value in Cell B2 in column A of the merged workbook.

Sub FileMerger()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

 ' ~~~ Remove all Windows Alerts, including and SAVE AS dialogue
    Application.DisplayAlerts = False

'change folder path of excel files here
        ' Home laptop
    'Set dirObj = mergeObj.Getfolder("C:\Users\Owner\Google Drive\Naz Islam\Consolidate\CSAT")

    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
   
' ~~~ Activate the worksheet that you want the data to be extracted from, remember ALL worksheets has to share the name
' ~~~ If worksheets have different names than you can use the worksheet ID "Worksheet(1)" as an example
     bookList.Worksheets("Sheet1").Activate
   
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A5:I" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next

Application.ScreenUpdating = True
'=============================================================================
' Credit M Riza / oa ultimate
' http://www.oaultimate.com/office/merge-multiple-excel-files-into-a-single-spreadsheet-ms-excel-2007.html
' =============================================================================

End Sub

Thanks in adavnce

 

[Luke M]

Change this line near the end:

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

to this:

With Range("A65536").End(xlUp).Offset(1, 0)
    .Offset(0, 1).PasteSpecial 'Do our paste in col B now
    .Value = bookList.Worksheets("Sheet1").Range("B2").Value 'Copy week number
End With

 

[prasaddn]

Hi,

You are already using the A column of merging book with data of A5 of each book.

where do you intent to place the value of B2 of each book in merged workbook?

Regards,
Prasad DN

 

[Portucale]

Hi Prasad,

If not possible in Column A then could be at the end, in this case would be Column J.

To Luke,

Thanks Luke, but I may not explain myself properly, sorry, in each of the merged worbooks/sheets there are many rows, so would need for the value in cell B2 to be filled throughout all the rows copied.

Hope this makes sense.

Thanks again for all the help.

 

[prasaddn]

Hi Revise your code as below:

'Do not change the following column. It's not the same column as above
 
dim iMylastRw as integer
iMylastRw =  Range("A65536").End(xlUp).row +1
 
Range("A" & iMylastRw).pastespecial
Application.CutCopyMode = False
 
Range("J" & iMylastRw ":J" & Range("A65536").End(xlUp).row).value = bookList.Worksheets("Sheet1").range("B2").value
bookList.Close

Regards,
Prasad DN

 

[Portucale]

Thanks Prasad,

Seems that there is an error in the line:

Range("J" & iMylastRw ":J" & Range("A65536").End(xlUp).row).value = bookList.Worksheets("Sheet1").range("B2").value

any idea?

cheers

 

[Luke M]

Missing an ampersand
corrected:

Range("J" & iMylastRw & ":J" & Range("A65536").End(xlUp).row).value = bookList.Worksheets("Sheet1").range("B2").value

 

[Portucale]

Hi Prasad,

Seems I got it, was one & missing between iMyLastRw and ":J"

Thanks,

 

[Portucale]

Thanks Luke