对工作簿内指定工作表简单汇总

jiandan2029

各位大神，示例工作簿有隐藏表，想达到将指定工作表内容简单汇总（复制）到收入汇总表。以后工作表还会有增加，可以根据现有模式修改。先谢谢了！

ykcbf1100

多表合并。

fzxba

Sub test1() '
  Dim Conn As Object, rs As Object, Sht As Worksheet
  Dim strConn As String, ar() As String, i As Integer
  Worksheets("收入汇总 ").Activate
  Cells.ClearContents
  Set Conn = CreateObject("ADODB.Connection")
  If Application.Version < 12 Then
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
  Else
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
  End If
  Conn.Open strConn & ThisWorkbook.FullName
  For Each Sht In Worksheets
    With Sht
      If .Name <> ActiveSheet.Name Then
        If .Visible = -1 Then
          i = i + 1
          ReDim Preserve ar(1 To i)
          ar(i) = "SELECT * FROM [" & .Name & "$" & .Range("A1").CurrentRegion.Address(0, 0) & "]"
        End If
      End If
    End With
  Next
  Set rs = Conn.Execute(Join(ar, " UNION ALL "))
  With Range("A1")
    For i = 0 To rs.Fields.Count - 1
      .Offset(0, i) = rs.Fields(i).Name
    Next
    .Offset(1).CopyFromRecordset rs
    .CurrentRegion.Borders.LineStyle = xlContinuous
  End With
  Set rs = Nothing
  Conn.Close
  Set Conn = Nothing
  Beep
End Sub

leirongqin

来学习一个

jiandan2029

ykcbf1100 发表于 2022-12-2 13:42
多表合并。

非常感谢！为工作带来相当大的方便！因为这个工作簿存在隐藏表，如何在不隐藏其他表的情况下，对三张表进行汇总，后期如果增加收入项目再进行扩展。

ykcbf1100

jiandan2029 发表于 2022-12-2 15:10
非常感谢！为工作带来相当大的方便！因为这个工作簿存在隐藏表，如何在不隐藏其他表的情况下，对三张表进 ...

如果不隐藏表的情况汇总其它三个表，那在汇总时就要固定表的循环。