合并几个Excel文件并按列alignment

我有一个文件夹中的几个Excel文件，并希望合并它们，但按列alignment合并的文件：

以下代码按行alignment文件夹中的所有文件：

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\mergeFolder") Set filesObj = dirObj.Files For Each everyObj In filesObj Set bookList = Workbooks.Open(everyObj) 'change "A2" with cell reference of start point Range("A1:IV" & Range("A1000000").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate 'Do not change the following column. Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False bookList.Close Next End Sub 

在这里你可以看到输出：

任何build议如何alignment这些文件每列？

我很感激你的回复！

更新

我得到的错误是这样的：

Answer 1

可能是这样的：

 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\mergeFolder") Set filesObj = dirObj.Files For Each everyObj In filesObj Set bookList = Workbooks.Open(everyObj) 'change "A2" with cell reference of start point Range("A1:IV" & Range("A1000000").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate if Range("A1").Value <> "" and Range("A2").Value <> "" then Range("A1").End(xlRight).Offset(0, 1).PasteSpecial else if Range("A1").Value = "" then Range("A1").PasteSpecial else Range("A2").PasteSpecial end if end if Application.CutCopyMode = False bookList.Close Next End Sub