作者在 2023-05-18 16:13:10 发布以下内容
分表的表头有合并单元格项,保留分表格式使用VBA合并多个分表,但是汇总表中之汇总了表头格式,表头内容却没有汇总进去,是什么原因呢?
是代码写的不对吗?以下是代码
Sub CollectDataFromShtFormat()
Dim sht As Worksheet, rng As Range, k As Long, nTitleCount As Long
On Error Resume Next
nTitleCount = Val(InputBox("请输入标题的行数", "提醒", 1))
If nTitleCount < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub
Application.ScreenUpdating = False
Cells.ClearContents '清空当前表数据
For Each sht In Worksheets '遍历工作表
If sht.Name <> ActiveSheet.Name Then
'如果工作表名称不等于当前表名则进行汇总动作……
Set rng = sht.UsedRange
k = k + 1 '累计K值
If k = 1 Then '如果是首个表格,则K为1,则把标题行一起复制到汇总表
sht.Cells.Copy: Range("a1").PasteSpecial Paste:=xlPasteFormats '只粘贴格式
rng.Copy: Range("a1").PasteSpecial Paste:=xlPasteValues '只粘贴数值
Else '否则,扣除标题行后再复制黏贴到总表,只黏贴数值
rng.Offset(nTitleCount).Copy
With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
.PasteSpecial Paste:=xlPasteFormats '粘贴格式
.PasteSpecial Paste:=xlPasteValues '粘贴数值
End With
End If
End If
Next
Range("a1").Activate
Application.ScreenUpdating = True '恢复屏幕刷新
MsgBox "汇总OK,一共汇总了:" & k & "张工作表"
End Sub
是代码写的不对吗?以下是代码
Sub CollectDataFromShtFormat()
Dim sht As Worksheet, rng As Range, k As Long, nTitleCount As Long
On Error Resume Next
nTitleCount = Val(InputBox("请输入标题的行数", "提醒", 1))
If nTitleCount < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub
Application.ScreenUpdating = False
Cells.ClearContents '清空当前表数据
For Each sht In Worksheets '遍历工作表
If sht.Name <> ActiveSheet.Name Then
'如果工作表名称不等于当前表名则进行汇总动作……
Set rng = sht.UsedRange
k = k + 1 '累计K值
If k = 1 Then '如果是首个表格,则K为1,则把标题行一起复制到汇总表
sht.Cells.Copy: Range("a1").PasteSpecial Paste:=xlPasteFormats '只粘贴格式
rng.Copy: Range("a1").PasteSpecial Paste:=xlPasteValues '只粘贴数值
Else '否则,扣除标题行后再复制黏贴到总表,只黏贴数值
rng.Offset(nTitleCount).Copy
With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
.PasteSpecial Paste:=xlPasteFormats '粘贴格式
.PasteSpecial Paste:=xlPasteValues '粘贴数值
End With
End If
End If
Next
Range("a1").Activate
Application.ScreenUpdating = True '恢复屏幕刷新
MsgBox "汇总OK,一共汇总了:" & k & "张工作表"
End Sub