TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
6 k7 n. z" W! O% l: q7 T1 E1 W% J8 f4 E. t0 v
Dim MyPath, MyName, AWbName1 a8 y* c. L3 G% }; j( u9 W& `
) N% g1 `( D0 l2 b% L+ D( P' X% h
Dim Wb As Workbook, WbN As String3 @5 a8 W; g5 K$ ^ a3 ?, n
. P. W! t1 R4 d8 t' SDim G As Long
0 U* K. u. u% c6 C# y0 @
0 y8 p- f% E1 W U# r6 S# EDim Num As Long
# Y! D7 C, F# P& D# ]. I" @$ w3 V1 M6 l' R7 D' O: F8 l/ p3 _
Dim BOX As String
( _) Z$ k7 _8 U
, m Q) ^$ e _9 Q* PApplication.ScreenUpdating = False2 o, d, P& z) |, j' g0 @! S' j
1 q1 K( w- }$ c
MyPath = ActiveWorkbook.Path! Y3 D a* t0 Q) S4 m! U0 Q. Z8 Q* F
6 x3 x; J4 x( l3 sMyName = Dir(MyPath & "\" & "*.xls")
( ]/ o& ?0 c: y5 [
% t" {1 I. h3 f! x& ]3 }AWbName = ActiveWorkbook.Name6 k7 z3 H* E1 L
1 S" r! d( n+ A
Num = 0- U8 @' J! u7 o1 n% \/ P
6 d( i( L' U! m* d) w2 a6 @, y6 O
Do While MyName <> "") p# l% I- M( ]1 [ E
% s$ F3 X9 n6 a4 y( LIf MyName <> AWbName Then
7 ]0 O/ [0 ^9 u7 w& ~) W" k; x" ^, L% t( _1 c$ B7 H) q' O
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
7 {% Y2 R8 p1 |, _2 d
0 w: @8 w( h6 j6 INum = Num + 16 ^6 B: V2 t1 M5 j5 y
/ n& I) n: _+ k7 }3 `" K: |. wWith Workbooks(1).ActiveSheet
; n/ m5 a' v- X( j5 p. z1 x& _8 H4 g* g7 V4 A1 u6 Z& g9 W
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)! g9 U! y6 }/ B {! B4 B2 K
( X, S/ v; T4 U3 u* U1 V- jFor G = 1 To Sheets.Count
, j+ m1 r! _$ U: t, p$ O1 N, [1 H- l6 |5 p6 W% w2 z. ]
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
3 r1 U* {7 d; }7 [2 x
) q0 v* U6 V' ?: b" B$ |' z1 RNext
, c8 `: }; }5 ~( p" c
' `2 \9 i* J$ J5 J: B6 a5 Q' FWbN = WbN & Chr(13) & Wb.Name) f4 F2 D+ f7 m4 p4 \4 l
/ c1 ^9 H. y7 _6 }# w
Wb.Close False
1 Y, P) i$ Z! { A k" n" R8 i) w, _7 Q! I4 B
End With9 I4 S8 o8 B) b& U+ u1 O% V
( }% P7 ~9 D( G% F% }
End If
/ j6 ]4 _+ q) ?+ b0 g1 B# H& W+ E1 T+ \. Y6 M" r/ w! W
MyName = Dir. z4 Y" U0 l( W) X) w7 R
0 K5 i6 }( Y* [1 X& o) j( P1 [
Loop
0 b9 |7 B4 G6 R2 h
; f) g l0 ^" Z g KRange("B1").Select
; Q) V. ?" t0 T6 F0 T" A3 w
" d2 p+ t+ q7 yApplication.ScreenUpdating = True
5 t. i7 p+ `6 L5 }
8 u8 ]; I1 F1 a& o1 Z5 }" g, rMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"2 ~% W" f: `3 o3 z3 [' e/ Y
0 |4 J0 }2 E, I o0 jEnd Sub |
|
发表于 2020-7-6 10:05:41