TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()) g7 ]) D% V3 k6 o1 y8 Q# r$ B, y
: E4 |! \, m6 w! q( n6 BDim MyPath, MyName, AWbName
5 b8 {9 M, \2 G2 ^- M8 G. g2 k6 k" ~6 F. `) Q% f1 I; ^: k
Dim Wb As Workbook, WbN As String
) u: v6 ~! V4 E6 m) L% H, v( G/ R) Q) @$ Y5 U+ Y$ n' N8 a4 b2 E
Dim G As Long
# `+ @8 U5 ~* j
+ O4 X, r; Y. m( p* k* zDim Num As Long; J+ o$ r! n' N6 V! u/ @; W: t
: v6 i1 f- N7 q" vDim BOX As String1 p! v2 o1 n! g; y c7 ~" s3 L
( b( C- j( S1 S# X: B
Application.ScreenUpdating = False; ^9 G; H- o& i
8 j) _) S; b$ X' W2 RMyPath = ActiveWorkbook.Path, h/ l8 o! V. r
& C; r% \+ Y. {' E- H, E
MyName = Dir(MyPath & "\" & "*.xls")/ Y: B( {6 u7 Y8 n2 M
9 h( e2 V: o, p) {AWbName = ActiveWorkbook.Name* a' ?# ^+ c- d, t: n# Y
% v* P! k& @- {3 V
Num = 0
Y6 c8 o, ~+ j, u8 I2 w* B! T, x
9 S1 J# @" |) l# P, ~" FDo While MyName <> ""! g! I5 l0 w+ b5 ^( o
" r, @& U* O4 `4 j0 W3 L9 ~8 Q
If MyName <> AWbName Then' D! Q% c7 b n/ Y7 _: `2 F9 Q
7 R& {* S9 M+ `( i5 kSet Wb = Workbooks.Open(MyPath & "\" & MyName)6 x5 q" n' q7 J1 f% O
( a3 ]8 q' E# O, G6 M% X) h
Num = Num + 1" M5 T' m# l* R
. p3 Z' W e4 T0 BWith Workbooks(1).ActiveSheet0 ` {" m2 O, e! u8 L8 y
7 g' F- E& X1 I4 p0 G6 Q$ n
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
8 h5 `& b* Z! J3 H1 ~: ]" `3 N
1 Y# L2 I/ }5 |' {For G = 1 To Sheets.Count' U$ z9 e* v" Y4 B) ?; E% s1 A' m
3 z# J2 o& \7 X' e! `" h$ d$ ~
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
, `( t! K1 Q% d! ]; D3 [$ _3 v7 N/ ~3 \& |
Next
( q% q! _! P% g R; z7 i( I. o5 z5 X; \
WbN = WbN & Chr(13) & Wb.Name! t8 w- K6 ~" l: ]8 S
3 y1 @. m l* M' ^% ~1 mWb.Close False
4 B* F/ V7 `- t+ R- a5 @/ o" e. l( ?( {5 V( f R
End With5 [% V0 n: N" `2 B. ? C
$ i! B: l! L: R# [- j0 |
End If
. _* I- r) K& K0 G
8 p- ~0 W9 M0 }. H. C5 `MyName = Dir( V2 C+ W# @8 e0 S
9 h2 B" B, `, D! {" ILoop
/ l7 V# x7 `9 E7 L: ~, P) I2 W! U8 X+ H9 q; ~, n2 P9 j$ Z
Range("B1").Select
, U8 F1 ?9 a4 e1 ]3 I5 o& }
, Z+ J8 R+ S: a9 c& t# d8 P/ n, LApplication.ScreenUpdating = True Q6 I8 w; v( E2 Q
/ {. M- u" V/ V/ U! }( kMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"8 p; n8 L2 N$ I) Q2 v1 R
0 _; E, d& M; P: o" C. u
End Sub |
|
发表于 2020-7-6 10:05:41