|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
这个代码我认为可以满足你的需求,是我从b站一位大神的分享学来的,你试试
- Sub 合并数据()
- Dim sht As Worksheet
- Dim rng As Range
- Dim k
- Dim n
- Dim a
- Application.ScreenUpdating = False
- '取消屏幕更新
- '---------------需要在选择汇总表才能操作
- If ActiveSheet.Name <> "汇总表" Then
- MsgBox "请新建或选择表名为:汇总表的表格再执行该操作"
-
- Exit Sub
- End If
-
- '---------------删除原先的内容
- a = ActiveSheet.UsedRange.Rows.Count '获取最后非空单元格的行号
-
- For i = a + 1 To n + 1 Step -1
-
- Rows(i).Delete
-
- Next
-
- n = Val(InputBox("请输入标题的行数", "提醒"))
-
- '--------------合并表
-
- 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
- [a1].PasteSpecial Paste:=xlPasteValues '仅粘贴数值
- Else
- '否则,扣除标题行后再复制黏贴到总表,只黏贴数值
- rng.Offset(n).Copy
- Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial Paste:=xlPasteValues
- End If
-
- End If
-
- Next
-
- [a1].Activate
- Application.ScreenUpdating = True '恢复屏幕刷新
- End Sub
复制代码 |
|