将此代码保存到模板文件里，将待汇总文件全部放入一个文件夹中。

此代码将从模板文件的第3个Sheet开始，根据Sheet名字，汇总目标文件夹中所有.xls文件的对应Sheet。

Sub 按文件夹汇总()
    ' 定义变量
    Dim folderDlg, folder$, file$
    Dim ignoreFilter As VbMsgBoxResult, deleteBlankRow As VbMsgBoxResult
    Dim sourceWB As Workbook, sourceWS As Worksheet
    Dim targetWS As Worksheet
    
    ' 选择文件夹
    Set folderDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDlg
        .Title = "请选择文件夹"
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
    End With
    If folderDlg.Show Then
        folder = folderDlg.SelectedItems(1) & "\"
    Else
        MsgBox ("未选择文件夹，汇总已取消！")
        Exit Sub
    End If
    
    ' 自定义汇总设置
    ignoreFilter = MsgBox("是否取消筛选（复制隐藏单元格）？", vbYesNo, "筛选")
    
    ' 遍历文件夹下所有文件
    file = Dir(folder & "*.xls")
    Do While file <> ""
        ' 不打开同名文件
        If file <> ThisWorkbook.Name Then
            Set sourceWB = CreateObject(folder & file)
            ' 汇总每个子表格内容
            For i = 3 To ThisWorkbook.Worksheets.Count
                Set targetWS = ThisWorkbook.Sheets(i)
                Set sourceWS = sourceWB.Sheets(targetWS.Name)
                If sourceWS.UsedRange.Rows.Count > 6 Then
                    ' 取消筛选判断
                    If ignoreFilter = vbYes Then
                        sourceWS.AutoFilterMode = False
                        If sourceWS.FilterMode Then
                            sourceWS.ShowAllData
                        End If
                    End If
                    sourceWS.Rows(6 & ":" & sourceWS.UsedRange.Rows.Count).Copy
                    targetWS.Range("A" & targetWS.UsedRange.Rows.Count + 1).PasteSpecial (xlPasteValues)
                End If
            Next i
            Application.CutCopyMode = False
            sourceWB.Close (False)
        End If
        file = Dir
    Loop
    
    ' 删除空白行
    deleteBlankRow = MsgBox("汇总完成！是否删除空白行（建议删除）？", vbYesNo, "删除空白行")
    If deleteBlankRow = vbYes Then
        For s = 3 To ThisWorkbook.Worksheets.Count
            Set targetWS = ThisWorkbook.Sheets(s)
            For r = targetWS.UsedRange.Rows.Count To 6 Step -1
                If WorksheetFunction.CountA(targetWS.Rows(r)) = 0 Then
                    targetWS.Rows(r).Delete
                End If
            Next r
        Next s
    End If
End Sub