How to Add Column in Final Excel file from merged

2019-09-03 09:43发布

I currently have this excel macro below that basically merging all files indicated in the path into one excel file.

Sub simpleXlsMerger()
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")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\MERGE")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'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("A2:IV" & 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
End Sub

Now, my problem is that, I want to include the file name of each excel file on one column of the final excel file that contains all the data from the merged excel files.

Also is it possible to include formatting in macros? Like the font style/size/bold?

1条回答
放我归山
2楼-- · 2019-09-03 10:14

I refactored the code a bit to be able to add the file name to column next to the right-most column for each data file pasted in. I commented my edits with **.

(For your 2nd question. There are numerous resources to see how to adjust cell formatting in VBA on the web. A simple search will yield many results)

Sub simpleXlsMerger()

    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Dim wbMain As Workbook '** just to work directly with this workbook object

    Application.ScreenUpdating = False
    Set wbMain = ThisWorkbook
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Dim lBeginRow As Long
    lBeginRow = 1 '** start with row 1 at beginning of loop

    'change folder path of excel files here
    Set dirObj = mergeObj.Getfolder("C:\Users\MERGE")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj

        Set bookList = Workbooks.Open(everyObj)

        '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
        bookList.Worksheets(1).Range("A2:IV" & bookList.Worksheets(1).Range("A65536").End(xlUp).Row).Copy wbMain.Worksheets(1).Range("A" & lBeginRow)
        '** in above line i work directly with sheet

        With wbMain.Worksheets(1) 'to work with ThisWorkbook, Sheet 1 (change sheet index number as needed

            Dim lEndRow As Long
            lEndRow = .Range("A65536").End(xlUp).Row '** get last copied row

            Dim lNextColumn As Long
            lNextColumn = .Range("A" & lBeginRow).End(xlToRight).Column + 1 '** get next column after data paste (asssume contigous columns of data)

            '** place file name in newly pasted range
            .Range(.Cells(lBeginRow, lNextColumn), .Cells(lEndRow, lNextColumn)).Value = bookList.Name

            lBeginRow = lEndRow + 1 '** reset next begin row before new paste

        End With

        bookList.Close

    Next

End Sub
查看更多
登录 后发表回答