TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()6 N% l' |1 _9 W$ @! M
! E& o& F7 G. `6 ~/ S
Dim MyPath, MyName, AWbName9 L% h4 o( u0 r$ A/ N
. y, M7 E3 p7 L0 U
Dim Wb As Workbook, WbN As String
3 f c9 i7 ^. `% X T
8 `* B( e# N+ _( d( _" H. KDim G As Long) m* m8 W/ P; Z2 \
: C5 t1 e) `! {# b2 C0 N$ M
Dim Num As Long; a, {. Y! o1 k1 [5 A+ ^: P
" J2 a- e% p( r. l, h3 q
Dim BOX As String3 J0 [1 G# @# d P0 B2 m
2 M; `6 d8 Z& Z: v9 QApplication.ScreenUpdating = False
. |( T# E0 j2 V) g2 |, C/ K" t. a$ n
MyPath = ActiveWorkbook.Path3 ?# b3 \4 A0 J) l( \& l
7 B) _! B- Q, Y7 M2 t
MyName = Dir(MyPath & "\" & "*.xls")- I& a7 S0 {+ _% N
- m5 S, c/ Y! k8 @' G' ~' mAWbName = ActiveWorkbook.Name
5 V, h" s/ z1 q, f+ v: y; F' q( A3 I' d4 N
Num = 0
7 Z+ r7 A# R9 h1 z) J1 q) K' C2 y; c% p2 W! e- R* Y
Do While MyName <> ""- ^6 V2 P. G0 D: \: A" w+ v6 H
3 V$ O5 Z1 l" ^: o2 Z% ?: L7 T
If MyName <> AWbName Then
" W5 ` _6 H3 a- O1 {+ {+ E8 m3 P2 r. S
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
' O& U, \, Z6 V& l9 U# l* p3 H# t7 O8 O; ~ V @1 U
Num = Num + 14 @0 b+ W# U% ]8 ~
9 \$ ^6 ~ j( z- Q
With Workbooks(1).ActiveSheet# ?' g$ [) p- i0 R: i
3 l) t* j! Y- @: R$ r' X.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
5 [9 V% U2 m/ R! g2 g7 r+ V: E$ I( B) s# ] s. q
For G = 1 To Sheets.Count5 C4 |9 U. T. m/ I* O
8 j2 T8 w! G3 J( o% \/ R( v+ p
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
8 W e6 G- g; Z( \7 Y9 z2 O U; W* l2 B' n; d! q1 X5 e8 l* q
Next( Q2 W9 o' m' {. [! h) f6 Z
! a3 V2 F3 c. s! i8 T m# n2 eWbN = WbN & Chr(13) & Wb.Name
. J; ~% x2 k& e; ?$ m' q% k+ q& g5 ^; F& b5 M- {
Wb.Close False6 F/ t9 a9 _" Z
# p) x7 Q" k- R1 X; OEnd With. Z# i2 q0 g7 `( Q: N5 E- w. V
! @) Y) p2 k6 M- u1 l, JEnd If
' H" B* c' s) m. X6 U: s; @+ W( T; C- w4 f: I
MyName = Dir
7 q2 u' W" G* ^/ C: l/ ]5 g7 M$ q5 Z3 r1 B1 A9 q" ~
Loop$ S: N4 E: h4 Y: n) S5 h
3 |# A: S4 j3 ^, o8 b% U
Range("B1").Select/ ?9 s' M0 [6 S R+ v3 g
/ N& K0 m6 m- r* D. o* ^ R( t/ m
Application.ScreenUpdating = True( h; j9 Y) B6 d1 V1 G$ {, X
, F# l( I4 I. H" q" I5 w: V0 SMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" u- V" q; ^% r# f% V3 g
7 R0 \; u+ V8 i1 b) B
End Sub |
|
发表于 2020-7-6 10:05:41