Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1588|回复: 6

[已解决]请求赐教:合并工作表。问题 ...

[复制链接]
发表于 2013-6-29 10:18 | 显示全部楼层 |阅读模式
请求赐教:合并工作表。问题是要将表标签作为标题.zip (6.22 KB, 下载次数: 7)
发表于 2013-6-29 10:41 | 显示全部楼层
回复

使用道具 举报

发表于 2013-6-29 10:50 | 显示全部楼层
  1. Sub 合并()
  2.     Dim lLastrow As Long
  3.     Dim i As Integer

  4.     With Application
  5.         .ScreenUpdating = False
  6.         .DisplayAlerts = False
  7.         .EnableEvents = False
  8.         .Calculation = xlCalculationManual
  9.     End With

  10.     With Sheet1
  11.         .UsedRange.Clear
  12.     End With

  13.     For i = 2 To Worksheets.Count
  14.         With Worksheets(i)
  15.             lLastrow = lLastrow + 1
  16.             .Range("a1").CurrentRegion.Copy
  17.             Sheet1.Cells(lLastrow, 1).Value = .Name
  18.             With Sheet1
  19.                 .Cells(lLastrow + 1, 1).PasteSpecial xlPasteAll
  20.                 If Not .Cells(lLastrow + 1, 1) Like "编制单位*" Then
  21.                     .Rows(lLastrow + 1).Delete
  22.                 End If
  23.                 .Range(.Cells(lLastrow, 1), .Cells(lLastrow, .UsedRange.Columns.Count)).Interior.ColorIndex = 4
  24.                 lLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
  25.             End With

  26.         End With
  27.     Next
  28.     With Sheet1
  29.         .UsedRange.EntireRow.AutoFit
  30.     End With
  31.     With Application
  32.         .ScreenUpdating = True
  33.         .DisplayAlerts = True
  34.         .EnableEvents = True
  35.         .Calculation = xlCalculationAutomatic
  36.     End With
  37.     MsgBox "合并完成"
  38. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
松儿 + 3 很给力!

查看全部评分

回复

使用道具 举报

发表于 2013-6-29 10:51 | 显示全部楼层    本楼为最佳答案   
请求赐教:合并工作表。问题是要将表标签作为标题.rar (12.98 KB, 下载次数: 32)
回复

使用道具 举报

发表于 2013-6-29 10:52 | 显示全部楼层
标题行的颜色和字体颜色可根据自己的需求换下就成了。
回复

使用道具 举报

发表于 2013-6-29 10:54 | 显示全部楼层
行高做了自适应
如果列宽也需要的话,
  1.     With Sheet1
  2.         .UsedRange.EntireRow.AutoFit
  3.     End With
复制代码
改为
  1.     With Sheet1
  2.         .UsedRange.EntireRow.AutoFit
  3.         .UsedRange.EntireColumn.AutoFit
  4.     End With
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-6-29 10:59 | 显示全部楼层
本帖最后由 松儿 于 2013-6-29 11:22 编辑
hwc2ycy 发表于 2013-6-29 10:54
行高做了自适应
如果列宽也需要的话,
把改为


谢谢!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 09:31 , Processed in 0.440756 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表