[已解决]VBA 工作簿下各工作表数据汇总

摩米 · 发表于 2016-11-24 14:26

本帖最后由摩米于 2016-11-25 14:07 编辑

详情请见附件
此工作簿有数据的子表为Sheet1--Sheet500
“工作表名称”列即对应各工作表
希望到结果：1、点击 “汇总” 可以在“汇总”工作表合并所有有数据的工作表内数据。
2.点击“筛选汇总”可以在“筛选汇总”工作表合并目录“筛选汇总”列下对应工作表数据。
"汇总"工作表和 "筛选汇总"工作表现在显示的数据，即为想要的结果。

请求老师费心编写一下，万分感谢！请大神帮帮忙

最佳答案

月排行榜 / 总排行榜

雨吧

2016-11-25 18:08

Sub 汇总()
Dim arr, i&
Sheets("汇总").[a2:i65536] = ""
For i = 1 To 500
With Sheets("Sheet" & i)
If Len(.Range("a2")) Then
arr = .UsedRange.Offset(1)
With Sheets("汇总")
r = .[a65536].End(3).Row + 1
.Range("a" & r).Resize(UBound(arr), 9) = arr
End With
End If
End With
Next
MsgBox "汇总完毕！"
End Sub
Sub 筛选汇总()
Dim arr, i&, j&
Sheets("筛选汇总").[a2:i65536] = ""
With Sheets("目录")
For j = 2 To .[k65536].End(3).Row
For i = 2 To .[a65536].End(3).Row
If .Range("b" & i) Like "*" & .Range("k" & j).Value & "*" Then
With Sheets(.Range("a" & i).Value)
If Len(.Range("a2")) Then
arr = .UsedRange.Offset(1)
With Sheets("筛选汇总")
r = .[a65536].End(3).Row + 1
.Range("a" & r).Resize(UBound(arr), 9) = arr
End With
End If
End With
End If
Next
Next
End With
MsgBox "汇总完毕！"
End Sub

复制代码

模板.rar (567.44 KB, 下载次数: 38)

雨吧 · 发表于 2016-11-25 18:08

Sub 汇总()
Dim arr, i&
Sheets("汇总").[a2:i65536] = ""
For i = 1 To 500
With Sheets("Sheet" & i)
If Len(.Range("a2")) Then
arr = .UsedRange.Offset(1)
With Sheets("汇总")
r = .[a65536].End(3).Row + 1
.Range("a" & r).Resize(UBound(arr), 9) = arr
End With
End If
End With
Next
MsgBox "汇总完毕！"
End Sub
Sub 筛选汇总()
Dim arr, i&, j&
Sheets("筛选汇总").[a2:i65536] = ""
With Sheets("目录")
For j = 2 To .[k65536].End(3).Row
For i = 2 To .[a65536].End(3).Row
If .Range("b" & i) Like "*" & .Range("k" & j).Value & "*" Then
With Sheets(.Range("a" & i).Value)
If Len(.Range("a2")) Then
arr = .UsedRange.Offset(1)
With Sheets("筛选汇总")
r = .[a65536].End(3).Row + 1
.Range("a" & r).Resize(UBound(arr), 9) = arr
End With
End If
End With
End If
Next
Next
End With
MsgBox "汇总完毕！"
End Sub

复制代码

模板.rar (567.44 KB, 下载次数: 38)

摩米 · 发表于 2016-11-25 19:16

雨吧发表于 2016-11-25 18:08

老师您的代码真的是好用，非常感谢您的帮助，老师您辛苦了！{:211:}

		自动登录	找回密码
密码			注册

[已解决]VBA 工作簿下各工作表数据汇总

相关帖子