如何使用excel的VBA将多个文件中的表复制到单个文件中的一个表中

I have multiple excel files with sheets like this:

我有多个excel文件,其中包含以下表格:

and this:

I would like to have a file with a table like this:

我想有一个像这样的表的文件:

The third file is a merged file with all the values in right place.

第三个文件是合并文件,其中所有值都在正确的位置。

Ps. I have to merge over 1000 files into 1 with all the columns sorted by name PPS I think that the whole file would have about 1000 columns (every column is a kind of object) and over 30000 rows

PS。我必须将1000多个文件合并为1,所有列按名称排序PPS我认为整个文件大约有1000列(每列是一种对象)和超过30000行

Can Someone Help me please?

有谁可以帮助我吗?

1 个解决方案

#1

Since you have your all file set up you could copy the header row into an array and compare the value with the first row of the other sheets

由于您已设置了所有文件,因此可以将标题行复制到数组中,并将该值与其他工作表的第一行进行比较

Dim HeadArray, CopyArray
Dim RowCountA as Long, RowCountB as Long
Dim ColumnA as Long, Column2 as Long

RowCountA = Workbooks("All").Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row
ColumnA = Workbooks("All").Worksheets("Sheet1").Cells(1,Columns.Count).End(xlLeft).Column
HeadArray = Workbooks("All").Worksheets("Sheet1").Cells(1).Resize(1,ColumnA)

'Will want to put the remaining code in a loop to accomodate the amount of files you are wanting
RowCountB = Workbooks("CopyBook").Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row
ColumnB = Workbooks("CopyBook").Worksheets("Sheet1").Cells(1,Columns.Count).End(xlLeft).Column
CopyArray = Workbooks("CopyBook").Worksheets("Sheet1").Cells(1).Resize(RowCountB,ColumnB)

For x = 0 to ColumnA - 1
    For i = 0 to ColumnB - 1
        If CopyArray(0,i) = HeadArray(0,x) Then
            For y = 1 to RowCountB - 1
                Workbooks("All").Worksheets("Sheet1").Cells(RowCountA + y,x+1).Value = CopyArray(y - 1,i)
            Next y
        End if
    Next i
Next x

RowCountA = RowCountA + RowCountB