Question

我目前在下面有这个excel宏，它基本上将路径中指示的所有文件合并到一个excel文件中。

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

现在，我的问题是，我想在最终excel文件的一列中包含每个excel文件的文件名，该文件包含合并的excel文件中的所有数据。

还可以在宏中包含格式吗？喜欢字体样式/大小/粗体？

Answer 1

我重新编写了一些代码，以便能够将文件名添加到粘贴的每个数据文件的最右列旁边的列。我使用**对我的编辑进行了评论。

（关于你的第二个问题。有很多资源可以看到如何在网络上调整VBA中的单元格格式。一个简单的搜索会产生很多结果）

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

如何从合并的Excel文件中添加最终Excel文件中的列

1 个答案: