TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
9 J2 H2 j% ?' o4 k8 ]3 U$ Q
4 p) n Z6 i( ]+ \Dim MyPath, MyName, AWbName$ n9 S' L9 B) ` m9 G
]/ N3 W% z& S; B0 P
Dim Wb As Workbook, WbN As String$ A p7 Q, V; B& J/ l1 j# n' B7 f
9 f' G/ i f5 @* o# U) |6 p$ M
Dim G As Long
: D6 E' \% [/ _, @- g6 ?
) i6 D+ B) |2 x- }4 K( K+ GDim Num As Long6 F: t) e2 E0 l6 u |9 k
; V5 g3 n0 g( ?& ^) {
Dim BOX As String
! C8 z P* X }9 }6 t& d
! k- L; T7 R+ bApplication.ScreenUpdating = False
, F; D5 b: Z2 V2 E1 G
/ s* j7 E- H* F4 _: SMyPath = ActiveWorkbook.Path
' o; N( \/ C0 u3 M$ k; k4 ?
* @8 U+ V }1 A- O% FMyName = Dir(MyPath & "\" & "*.xls")0 U7 c9 ?8 Y, |" u0 ^% G
* r7 {5 A5 v2 zAWbName = ActiveWorkbook.Name
; h1 s5 A/ S9 O$ X
, i+ ~- ?) Q% X* a# _0 S3 iNum = 0
: Y9 b4 X, \# O- U, n. E3 P8 q' ?2 J. l( h z- D
Do While MyName <> ""
) t) v2 S/ F. ]& c) A" V+ X& S" z1 K. ^
If MyName <> AWbName Then$ s B2 m3 B8 O) V4 I8 q& t7 w
' U* X! M# @, ^1 dSet Wb = Workbooks.Open(MyPath & "\" & MyName); ~7 f: j0 ~3 b3 I2 W* P
- u8 b9 | D8 w
Num = Num + 1( `+ @- @& C5 {0 p
4 [4 V) c3 q3 ]4 m8 o" zWith Workbooks(1).ActiveSheet
! m* S4 M: a* @$ p: k( b2 z6 o6 q" y6 T$ |
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)( q' h3 e4 d/ m, D* W
6 D' M( j; e& o9 s
For G = 1 To Sheets.Count
4 Z; P9 w* `7 Z2 Z+ B1 E; ~7 s! l9 w8 x& T7 B: r8 n
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1), L0 O- T% r0 x, c" H3 v
* d" F6 k# | i4 J n8 r: y
Next$ Z( v7 |7 V& Z: @/ X
+ \: |6 n' ?' l# z
WbN = WbN & Chr(13) & Wb.Name
: ?' p2 R% Y& `4 P8 ]) B6 W3 {* Y( J( F) {" X0 _3 U' ^
Wb.Close False
+ z, i$ m1 {. e* G' F) _0 I4 e+ S G( ~3 m, \
End With
3 R: ]" c# r6 h3 E5 }; G& {+ x
8 K3 l' V ^6 R, a7 T: nEnd If
) e3 U0 t# k7 L. W7 d/ ^
w4 |/ @5 V8 \) U- R6 I& r9 XMyName = Dir; ~3 M- M5 C! W& Z% c2 J3 S0 W
3 h; B( V+ q2 [% jLoop
( e3 |6 k5 f; T# w* n \: }/ N- V
Range("B1").Select
: N& ~4 o8 J; S) E7 r( K5 w
& u4 u. ?' N8 JApplication.ScreenUpdating = True2 C- K& f/ I1 M; P0 b3 c2 U# w
: ~9 O6 w4 `; D6 x3 @
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
" j& d& c+ V$ e% Z
! h- y" L. y* P$ iEnd Sub |
|
发表于 2020-7-6 10:05:41