TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
1 w% |9 b; C. `& B9 J6 j
* F9 o7 J8 ?5 C8 [9 d6 hDim MyPath, MyName, AWbName1 S/ B K) l4 D7 k! K
1 X3 N# ~( k) `$ M( j
Dim Wb As Workbook, WbN As String
+ e" p2 A$ b6 u1 g) K6 x7 ?+ |0 c) x* _
Dim G As Long
, n% b. l3 U3 \5 A" u5 Y
3 p. g) U: g( ^Dim Num As Long8 e, s1 s4 t3 }* I
% p% X5 n* ?1 H+ p( D: UDim BOX As String3 I; t5 Z5 S' O, A& r) h; B7 a+ v
; M) G: I" y- }" Y. ]8 C4 O
Application.ScreenUpdating = False' N7 o `) L3 [% P0 H, b! @$ v
2 n# N; u3 Q; w% d, s0 i0 `7 w9 oMyPath = ActiveWorkbook.Path, K2 R6 s" Y( {9 V6 e7 i0 M
* D0 o% B5 V& N
MyName = Dir(MyPath & "\" & "*.xls")
9 V8 C5 V# l% }3 u2 y- q& ?
: j2 o1 P7 @8 g2 n6 o- }- H1 UAWbName = ActiveWorkbook.Name
" V+ H, `% B* D. _1 r4 s) m- n x1 R/ n/ p( s* Z& G
Num = 0
% Q5 X2 ]7 d) I0 B3 g5 {' [, e& d8 d' |. A4 h& z4 {
Do While MyName <> ""7 ~$ s2 @7 `1 _8 g
: Y+ m/ `0 _# I% p
If MyName <> AWbName Then
2 A, m- Y- i9 J3 W! K% h$ t
4 t) @# c, f) D( e5 b6 D- fSet Wb = Workbooks.Open(MyPath & "\" & MyName)8 y( o1 j {, Y' @' `3 g
4 A# x* E2 T2 `3 A9 p) sNum = Num + 1
1 c: Z" Z% Y$ d p5 M; [0 Z
" o1 e5 B. c7 K9 C8 c# kWith Workbooks(1).ActiveSheet
: Y4 I, b; Q/ X' w" s* y1 E# [( ]/ {# }) W% N/ y( f* [' Z
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) T) i$ Y4 Z% \ u
3 G! R1 w6 n i: qFor G = 1 To Sheets.Count
. y0 X# s7 }; W" B2 P
& [" F0 {8 {& s: U: ]$ VWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)' t' }2 m3 q8 O/ V( x
L, o0 f T( m: i7 lNext1 ^8 z- y$ i7 _, B+ e, ], C
* O) f0 Y3 s' F2 H3 c/ OWbN = WbN & Chr(13) & Wb.Name& ?9 z5 h; ^$ T: J$ e1 b2 Z
+ g3 h, X& L3 S. B. L& mWb.Close False
" K4 ~5 k- d+ ~2 k
$ F! p* W w7 C6 v' I* \7 {End With1 B+ ^+ ~+ L2 t
% o; C2 n6 t. E% REnd If1 e* y: ?0 w; ?
& w' y$ z7 W, g: v& {1 ?+ P9 dMyName = Dir& L5 O& H; |1 X; F& t" h1 }; J. G
, x T* Y k. k# G6 \Loop
! b# d1 p+ I* k! G4 W
/ p2 u7 J4 f5 L- D( T3 XRange("B1").Select
& }9 ?+ _% X# d% E
" w- Z4 j- \" I- \8 X9 A2 n( BApplication.ScreenUpdating = True, D; q# f0 n* G: V9 v: K) R
+ w7 f+ v8 E0 Z- A
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
# T \; Q- l* F, H6 B2 y( S: F, k! p% B
End Sub |
|
发表于 2020-7-6 10:05:41