本操作可实现,各个sheet表的数据汇总到汇总表
Sub collect()
Dim sht As Worksheet, rng As Range, k&, trow&
Application.ScreenUpdating = False
trow = Val(InputBox("请输入标题的行数", "提醒"))
If trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
Cells.ClearContents
Cells.NumberFormat = "@"
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
[a1].PasteSpecial Paste:=xlPasteValues
Else
'否则,扣除标题行后再复制黏贴到总表,只黏贴数值
rng.Offset(trow).Copy
Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial Paste:=xlPasteValues
End If
End If
Next
[a1].Activate
Application.ScreenUpdating = True
End Sub
网友评论