|
Sub CollectData()
Dim Sht As Worksheet, Rng As Range, k&, n&
Application.ScreenUpdating = False
'取消屏幕更新,加快代码运行速度
n = Val(InputBox("请输入标题的行数", "提醒", 1))
If n < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub
'取得用户输入的标题行数,如果为负数,退出程序
Cells.ClearContents
'清空当前表数据
For Each Sht In Worksheets
'遍历工作表
If Sht.Name <> ActiveSheet.Name Then
'如果工作表名称不等于当前表名则进行汇总动作……
Set Rng = Sht.UsedRange
'定义rng为表格已用区域
k = k + 1
'累计K值
If k = 1 Then
'如果是首个表格,则K为1,把标题行一起复制到汇总表
Rng.Copy
[b1].PasteSpecial Paste:=xlPasteValues
[a1] = "工作表名称"
[a1].Offset(n).Resize(Rng.Rows.Count - n, 1) = Sht.Name
Else
'否则,扣除标题行后再复制粘贴到总表,只粘贴数值
Rng.Offset(n).Copy
With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
.Resize(Rng.Rows.Count - n, 1) = Sht.Name
.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
End With
End If
End If
Next
[a1].Activate
Application.ScreenUpdating = True '恢复屏幕刷新
MsgBox "汇总OK"
End Sub
这个代码是汇总工作表的,请问下,如果只是想汇总各个被汇总表的某一区域比如A2:E10,要怎么修改代码,?谢谢
|
|