最新WPS办公软件学习教程_免费企业办公软件下载_金山WPS Office官网论坛

 找回密码
 
楼主: 天远

[VBA/VBS教程] 天远ET工具箱新功能介绍及源代码解读3——合并工作表

  [复制链接]

0

主题

0

听众

2

积分

LV.1

Rank: 1

该用户从未签到

金币
3
威望
1
帖子
3
精华
0
发表于 2016-2-23 21:50 |显示全部楼层
分享到: 新浪微博 腾讯微博
楼主您好,烦请改进一下,我只想合并多个工作簿中的sheet1工作表到一个新的工作簿,请问如何实现。
回复

使用道具 举报

1

主题

0

听众

4

积分

LV.1

Rank: 1

该用户从未签到

金币
3
威望
9
帖子
3
精华
0
发表于 2016-2-23 22:28 |显示全部楼层
天远的东西要支持。
回复

使用道具 举报

1

主题

0

听众

69

积分

LV.2

Rank: 2

该用户从未签到

金币
2
威望
113
帖子
66
精华
0
发表于 2016-2-24 14:16 |显示全部楼层
围观一下
回复

使用道具 举报

72

主题

9

听众

769

积分

测试体验团员

Rank: 14Rank: 14Rank: 14Rank: 14

签到天数: 59 天

[LV.5]常住居民I

金币
53
威望
1193
帖子
387
精华
1

测试体验团

发表于 2016-9-20 23:03 |显示全部楼层
谢谢大神.....................
回复

使用道具 举报

0

主题

1

听众

6

积分

LV.1

Rank: 1

该用户从未签到

金币
2
威望
3
帖子
7
精华
0
发表于 2016-10-9 16:09 |显示全部楼层
好功能,非常喜欢。
回复

使用道具 举报

0

主题

1

听众

1

积分

LV.1

Rank: 1

该用户从未签到

金币
3
威望
1
帖子
1
精华
0
发表于 2017-2-15 16:10 |显示全部楼层
、、、、,,,,,,,,,,,,,,,,,,,,
回复

使用道具 举报

0

主题

1

听众

3

积分

LV.1

Rank: 1

该用户从未签到

金币
3
威望
1
帖子
3
精华
0
发表于 2017-11-16 17:34 |显示全部楼层
01 Public Sub MergerAllWorksheet() '合并所有工作表到一张新建工作表中
, {1 }+ ]+ |9 h) V  l! K" n* R02 On Error Resume Next
- _$ t8 `5 c- v4 m03 Application.ScreenUpdating = False '关闭屏幕更新,加快速度6 X, p7 t  k! z$ B5 N4 `
04 If 1 = Worksheets.Count Then '如果只有一张工作表/ W" z# b+ V4 K% b4 ]
1 z6 g1 P; b3 e" e5 z; m% ^05     MsgBox "当前工作簿只有一张工作表!", 0 + 64, "天远ET工具箱"6 |/ P& D: R1 d( e9 h7 u3 Q8 l
  @/ M2 u9 h, N/ J: B8 g06     GoTo myExit! ?8 C: a' Q. g
) Z+ M2 ~2 x7 R3 Y) W" |6 g' h07 End If) u2 I  T6 N3 U2 J8 c
. C& K0 M: `- n, r7 m( C08 Dim ShtOldOne, ShtNewOne As Worksheet/ q) V. ^* J2 x1 A5 K- V
09 Set ShtOldOne = Worksheets(1) '取得当前第一个表" h. d( @& ?# ~1 ]+ p% F. |& p- y' ~1 D# j0 o
10 Set ShtNewOne = Worksheets.Add(ShtOldOne) '新建一个表1 s  u! R0 O0 W
11 ShtNewOne.Visible = True1 @) Q% ?# y" {( U% T5 C( Z
* i0 ]+ N7 E8 g! K* ^12 Dim i As Integer/ R1 P3 G6 ^9 `: u; S7 c
13 Dim r As Long  A- Q, C4 o0 c4 S2 f, B$ K) ^% U) T9 Q  Z/ @
14 r = 1
- {; G6 _' R; Z. `1 {0 Q15 For i = 2 To Worksheets.Count '新建的表是第一个表,遍历后面所有表
1 m8 Z: ~1 c8 M* l16     With Worksheets(i)- J$ x0 a4 B! u3 S/ n# l! _* k
17         .UsedRange.Copy '复制已经使用的区域2 l9 N  e, `4 V5 A. R  _7 P. u! q, {
18         ShtNewOne.Cells(r, 1).Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).PasteSpecial '粘贴到第一张表的最后
, k+ r/ F8 u1 W3 H& H3 K19         r = r + .UsedRange.Rows.Count- t+ V, Q. p# t# ]: A) \" L! a+ P0 H6 H) o1 h
20     End With9 B5 H% W4 b& X( |, U+ z- O- I9 t  v' L3 {  A3 M% n. q( O- [. t
21 Next i
; A! m+ G' M! a; R. N* b22 With ShtNewOne, Z8 U; o( }9 t. G. \& L( v  s" ?$ I% J! O
23     .Hyperlinks.Add .Cells(r + 1, 1), "http://bbs.wps.cn/thread-22349095-1-1.html", "", "访问天远ET工具箱", "本表由天远ET工具箱自动生成"2 h! Z  S% S( k; I0 K; d
24 End With
: j0 r3 u& c* ?8 `' S6 Z5 K25 MsgBox "合并工作表成功!", 0 + 64, "天远ET工具箱"1 ]$ w9 O- J8 Q7 ^! @9 }# O. R6 Z* f+ E% J
26 ShtNewOne.Activate1 D$ Q) y" E& }$ k
27 Set ShtOldOne = Nothing. t2 f/ g  y7 n2 ?7 H" m+ n$ }3 U5 I# o0 U8 W- A8 B, G% {
28 Set ShtNewOne = Nothing8 i7 R! [' v' `6 B& l
29 myExit:: B0 E- `* M  s# X
/ K! Y! J3 k5 [' ]# e30 Application.ScreenUpdating = True, j1 N, w5 d) G: p+ G* C: ~( c$ v( Z. l$ N  F" s
31 End Sub
回复

使用道具 举报

*滑动验证:
您需要登录后才可以回帖 登录 | 更多账号登录:

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛 ( 粤公网安备 44049102496073号 粤ICP备13015957号-1   

GMT+8, 2018-1-21 22:33

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部