TA的每日心情 | 难过 2020-11-4 15:03 |
---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
' H' D* Y- O5 n+ v9 A. _0 a% U* G3 z+ o. y: a# H( Q, w
Dim MyPath, MyName, AWbName# P/ x' V: ^4 q! u
3 |8 p* R$ W/ C9 N* ]
Dim Wb As Workbook, WbN As String+ `* N4 ?0 { C9 f5 ?8 e
6 r% f$ v9 F+ D; g0 M4 ]
Dim G As Long5 u7 G, ]4 ^4 y* t! O6 N9 F
, w. Z! q" c4 \$ g6 |
Dim Num As Long
3 ^( C8 f* C. \7 L4 L0 M( l$ o/ G0 o/ H. n" |6 e; [; G
Dim BOX As String
- k7 c1 G+ T, N. y) A
0 {7 T; B9 Z# PApplication.ScreenUpdating = False) j; a8 B- W$ J4 `( L
& `! i5 G2 A& z% d) `
MyPath = ActiveWorkbook.Path
6 E7 q) C& i2 l1 p. m$ o( h7 j
3 F$ T: M# \. tMyName = Dir(MyPath & "\" & "*.xls"), _3 d- R u+ G; s5 Q4 K
9 X2 i+ k& q) _% k6 H$ F& x
AWbName = ActiveWorkbook.Name
. i7 S. D+ Q3 E: F* G7 V _6 g1 w$ _/ w' h" o/ U L
Num = 02 s! ~3 A5 Z% T" x/ c$ y
, r( b0 K- f5 k$ U+ E
Do While MyName <> ""& C8 v( ^+ H' p1 x+ v) K7 X3 I
1 I( _* k0 c, f" H( e+ V2 yIf MyName <> AWbName Then' k V/ A" @3 }8 b! ^* S* {" Y
3 g* ?) f( g2 _2 p6 X/ e8 f3 ^7 Q J
Set Wb = Workbooks.Open(MyPath & "\" & MyName) T& L8 j \+ F! x$ q/ ~' T+ c( _
# ]+ Q6 R6 {6 V: oNum = Num + 1 I* D# i& @+ ?9 {
" `8 A! u. `: mWith Workbooks(1).ActiveSheet
7 c# z' Z( _ T. H0 k$ ?. s
7 Q+ M, r/ w4 }) ?0 l.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
. h6 |; u5 W$ V, i' |* L) W s8 m. y8 i" v6 o
For G = 1 To Sheets.Count- l$ A( y9 B1 r& e* c& W
" p( o$ o7 ^* i+ j V" X! e# k
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)2 y9 o. e8 N6 c
9 C' e& Y6 I/ INext
y9 `3 M' }' k
+ i) ^- |# a8 C" X) ?WbN = WbN & Chr(13) & Wb.Name2 C; U0 o% g5 Q6 c9 G( D5 A
3 n! k4 G0 q( f2 P: ~* aWb.Close False: H' z: ]" f L2 H) t
" w: g( C- \/ uEnd With
5 p1 J, ]% o7 c: |! t! V
: M" X( p( V8 B( C4 ] C( y9 pEnd If- W& v+ o( u+ B( @6 j. r( ]: {
7 X h6 d) E1 U! U$ D% {: jMyName = Dir9 e$ M% }7 i3 Y1 {
7 [. t9 P0 c5 k$ M( [Loop
% z- K* o3 d, @, j/ h( R7 Z' x6 s u" D2 M* C0 X Q2 e
Range("B1").Select
8 i9 K3 @1 M7 D8 U ~# }$ \
5 G/ K. L: a0 K# vApplication.ScreenUpdating = True
# ~) u/ H5 ^/ Y* Y. ?
! i. Z* k* S+ mMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
+ a+ `" M" `% v$ U/ p) \* b# O, O" c0 H. ~& n: i6 }, D6 _
End Sub |
|