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

我目前有这个macros下面的macros基本上合并所有文件path中指示到一个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文件中的所有数据。

也可以在macros中包含格式？ 像字体样式/大小/大胆？

Answer 1

我重构了一下代码，以便能够将文件名添加到粘贴每个数据文件的最右侧列旁边的列中。我用**评论我的编辑。

（对于你的第二个问题，有很多资源可以看到如何在Web上调整VBA中的单元格格式，一个简单的search将会产生很多结果）

 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