【附件】AU3汇总EXCEL表格（带格式不带公式）请教[已解决]

天芯蓝影

1.复制1~5甚至更多文档中结果统计（可能叫统计，汇总等名字，有多个，但是种类固定）到一个新的SHEET1
2.复制1~5甚至更多文档中列表（可能叫问题列表，列表目录，有多个，但是种类固定）到一个新的SHEET2
3.以上复制中复制格式，颜色，列宽等属性，仅复制公式计算出的值（不复制公式），见理想效果图

难点：要把需要的内容复制，但是不复制公式，要复制格式，有合并单元格，需要判断行末尾等等


说下今天尝试了一天的研究结果，如果没有合并单元格和公式，逐行读取写入就可以实现
有了合并单元格之后，上面的方法很大概率出错，另外碰到过几次，复制到第2，第3个文件中的合并单元格出错，之前的是可以的
寻求讨论共同解决问题，谢谢

另外用VBA试了下，也没有简单的实现方法，实在不行可能就只有用VBA先把需要的SHEET复制到一个工作表中，然后合并不带格式再设置格式了

这样写的程序相对较死板，很难通用了

netegg

同一工作簿中的不同工作表的格式本来就是独立定制的

kevinch

看不懂，不过楼主提供的表格我们一般称之为看的表格，对于数据处理，这类表格让事情变得复杂，方便数据处理的表格只能是行列形式的二维表格，不要有合并单元格，只要源数据是易于处理的格式，对于实现想看的表格都是方便用程序处理出来的，而当源数据都是方便看的表格时，困难^2

天芯蓝影

用VBA算是勉强实现了，后续有时间再优化吧

Sub 汇总数据()
    Sheets.Add
    With ActiveSheet
        .Name = "汇总表" & Format(Now, "hhmmss")
        For Each s In ThisWorkbook.Sheets
            s.UsedRange.Copy .Cells(.UsedRange.Rows.Count + 1, 1)
        Next
    End With
End Sub

Sub 合并EXCEL文件()
    ActiveWorkbook.Save '先保存目标文件
    Dim FilesToOpen '缺省情况被声明为 Variant
    Dim X As Integer
    Dim I As Integer
    Dim Mname As String
    Dim Oname As String
    Dim Keyn As String
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Mname = ActiveWorkbook.Name '目标文件名
    FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", Title:="", MultiSelect:=True)
   
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "没有选中文件"
        GoTo ExitHandler
    End If
   
    Keyn = InputBox("请输入需要合并的工作表名(包含关键字)" & _
        Chr(10) & "后续所选文件的全部工作表导入,直接按确定或取消") ', , ActiveSheet.name)
   
    X = 1
    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(X)
        With ActiveWorkbook
            Oname = .Name '源文件名
            For I = 1 To .Sheets.Count
                If InStr(Sheets(I).Name, Keyn) Then '如果Keyn为空则全部复制
               
                    .Sheets(I).Copy after:=Workbooks(Mname).Sheets(Workbooks(Mname).Sheets.Count) '复制到目标文件的最后一张表
                    Workbooks(Mname).Sheets(Workbooks(Mname).Sheets.Count).Name = Replace(Oname, ".xls", "-") & .Sheets(I).Name '重命名
                End If
            Next I
            .Close '源文件关闭
            X = X + 1
        End With
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

天芯蓝影

先把需要汇总的都整到一个EXCEL中，然后再合并一下

天芯蓝影

用VBA代码解决了这个问题，结贴

分三步走
1.汇总目录下所有需要的工作表
2.汇总当前EXCEL下刚才收集到的工作表
3.删除汇总的多个工作表，保留总表