TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
/ L- t" Y( z/ ?+ a- w, f- V- t3 a6 V- k
1 o$ k: ^! Z$ yDim MyPath, MyName, AWbName
. y0 H! L& B5 s# f' _; Z, i6 I- O2 }
Dim Wb As Workbook, WbN As String
- \2 l# `9 |; k$ \8 q$ }( n: M3 `3 x! u q3 K
Dim G As Long; g# J- H. R. U
& ^' H) ?+ Z* t. ~& [
Dim Num As Long
' Z" [( @3 D6 l0 Q: C! H
6 M+ o6 O9 m2 [1 a# J+ JDim BOX As String6 h* y4 t1 s! D- f0 J
; T0 E5 _8 @& B, y
Application.ScreenUpdating = False
' s$ S8 F# M$ N: e6 V
9 k3 X; @1 U+ T8 x$ vMyPath = ActiveWorkbook.Path
7 {+ U# F' p. |& }6 O% r& P+ r* Q7 c [2 Y: X) U; Y
MyName = Dir(MyPath & "\" & "*.xls")$ k) [# X- }# R
0 O; L3 [( ^3 b. e) p7 L) S
AWbName = ActiveWorkbook.Name
1 S' C& x) N3 b) r2 B0 O( ~# t/ R; z! ~9 E, q
Num = 00 P7 K' _- L* L
( D% q8 Z' i* w% u0 K+ P( N- xDo While MyName <> ""
1 x$ }0 l. _+ h; s8 A* j* z
: k. u T% G7 G+ r" AIf MyName <> AWbName Then" `/ i5 [1 ]6 [0 l0 x
' x- a. p# T' l/ M# X8 KSet Wb = Workbooks.Open(MyPath & "\" & MyName)
9 S) a! D5 O' x: l
! X( O6 o0 b1 e) `9 D4 |Num = Num + 1
- ^7 O4 ^# O! v- L, a% w- L- f v+ g0 J
With Workbooks(1).ActiveSheet4 X6 z/ t# }$ R
( Z. Y* F! \% c7 K& y/ O5 l; O0 u
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)0 i: Z5 O. h9 e& P9 d; c
/ o, w) _) i4 a/ NFor G = 1 To Sheets.Count, G3 [# Z) V$ n! L8 ^, T2 ~
6 M" W. k- a3 e, B8 h6 XWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)* j( w4 {( e5 F6 v8 a/ e% A9 C
2 ~( m; \0 h P, a7 k3 nNext
& u; f* s5 m, s0 z+ W5 l- R6 O) E' ?) t2 k
WbN = WbN & Chr(13) & Wb.Name( z3 R @) ^5 ]; W5 g' u
! i0 Q c0 O7 [. A& O. ]/ YWb.Close False
" K. C- U* T% R1 ^5 Q3 V! O2 A g% r# h9 m5 l0 u- m e. u
End With; P& i/ L Y7 j( G
9 v6 v x3 a+ a" [$ ^; LEnd If. i, D6 ?9 t, F0 `% l" r
0 ]7 e, K& P# W2 g1 Q) @
MyName = Dir4 p* s. _! f* _& l
/ t7 L& C* z* \+ uLoop) _5 D5 c6 Q9 S
- u1 G7 J0 l: e# ^4 BRange("B1").Select
$ z. A+ g; U8 V% ]$ ?) S$ |! T
) ]# C$ }5 p/ W$ t4 N; C8 n% zApplication.ScreenUpdating = True, q, K2 i6 T7 N' b, V, u5 d* I/ I
0 i' \" D, D) \% P0 `MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
( s* y7 x2 {# V; U
* y! K' D7 s( n0 o) v3 d# Z# P& E1 c" f4 SEnd Sub |
|
发表于 2020-7-6 10:05:41