VBA案例3：合并多个结构相同的文件

有多个结构相同的文件，需要合并到一张表中，

如截图中一个文件夹中的文件1、文件2，合并为最终的输出结果：

其结构均相同，如下：

合并后的结构也是如此。

合并提示如下：

程序代码：

程序代码：

Private Sub CommandButton1_Click()

Dim wb As Workbook

Dim str As String

Dim strr As String

Dim Str2 As String

Dim cot As Variant

Dim cot1 As Variant

Dim dic As Object

Dim temp

Sheet1.Cells.ClearContents

Application.ScreenUpdating = False

Application.DisplayAlerts = False

temp = ThisWorkbook.Path

objectname = ThisWorkbook.Name '目标文件名

Set fso = CreateObject("Scripting.filesystemobject")                    '取目标文件

Set myf = fso.getfolder(temp)

c = 0

On Error Resume Next  '有错继续

For Each i In myf.Files '开始打开文件

If Right(i.Name, 7) <> Right(objectname, 7) Then     '防止重新打开文件打开有重名

        Str2 = i.Path

        Set wb = GetObject(Str2)

        r0 = Sheet1.Range("a65536").End(xlUp).Row '合并的文件行数

        

    c = c + 1

   

     With wb.Sheets(1)

        r1 = .Range("a65536").End(xlUp).Row '数文件的行数

        c1 = .Range("A1").End(xlToRight).Column '数文件的列数

            If c = 1 Then '只有第一个文件取标题

                Sheet1.Cells(r0, 1).Resize(r1, c1).Value = .Cells(1, 1).Resize(r1, c1).Value

            Else

                Sheet1.Cells(r0 + 1, 1).Resize(r1 - 1, c1).Value = .Cells(2, 1).Resize(r1 - 1, c1).Value

            End If

    End With

        

 End If

        wb.Close savechanges:=False

        Set wb = Nothing

        

Next i

MsgBox "成功合并" & c & "个文件"

End Sub