TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表(); |' B. r, @9 W
, D% S& Y, x0 z
Dim MyPath, MyName, AWbName/ c3 Q0 e3 m4 q. O& K1 t1 O
; K$ `" j( C& J9 l: f6 C8 L! Y& tDim Wb As Workbook, WbN As String I& Z& P$ x- s1 ~
: j1 R0 Q7 I0 q. g& ^8 X. r
Dim G As Long0 C' p( y* [7 @
- ~$ _: S, w9 b3 L C
Dim Num As Long5 a: ^# Y ^9 m3 s7 P
7 B4 i5 _( ^! W1 A$ n& M: iDim BOX As String
+ ]; `2 T; `: z$ }, f* R' A1 S/ ^
$ Z1 v! f+ E; AApplication.ScreenUpdating = False! G* W9 ]8 ~" z# B2 y' |9 Z, J
& A; W! s- m- b* y& J+ m3 R9 d/ m
MyPath = ActiveWorkbook.Path$ Y+ P; F9 M% z G1 W$ y" O! }+ S
' f. K; S. P3 d8 x% c: I% C4 F* iMyName = Dir(MyPath & "\" & "*.xls")
& e- _& ^* I3 k3 }0 l" ^
) H) A7 D! V: H9 @' W9 i. dAWbName = ActiveWorkbook.Name
: a5 J9 s; s) f9 B! ^3 F- S% P6 q
Num = 0. Y' m: s7 y+ C# m+ m9 ~6 j6 F
$ Q* H0 K0 P# H$ y$ F! S0 ADo While MyName <> ""2 `1 J& A# J. U o, t
. c6 u: v Z. K& z4 L: Z$ u) p) aIf MyName <> AWbName Then
W9 C$ {) \# i8 H- {$ b" K
$ Z2 Z; T. C* {# aSet Wb = Workbooks.Open(MyPath & "\" & MyName)
- ]8 K, F( D1 m7 n2 o3 V; ^4 H% O |
Num = Num + 10 T F# R |- k5 D, X$ e7 B# a: [
2 ^: H3 v9 V3 ]7 v7 MWith Workbooks(1).ActiveSheet
' U2 j' R. ^7 R' |
: B; L6 `: G# o' m# }2 ^.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)# C# @8 Z, p5 j7 C! r: T0 {( J
8 s( w& d# C. E- f
For G = 1 To Sheets.Count
2 p7 ]& l0 C/ D- l& P" v6 Y8 I9 \
/ x9 }% d5 t5 `* s, YWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)3 Q6 R4 K* r* J) K) Y( _
$ A4 F4 B4 m5 S1 |4 t8 s' i
Next
- c+ M) p5 s" q, Y. p
- a {( h& I ?& y0 RWbN = WbN & Chr(13) & Wb.Name+ [, w+ N: [# X$ [5 Y& z9 c
& N6 P6 b4 B" R0 o1 C1 B. S
Wb.Close False. H. r' f0 [. s9 T3 j6 X
( i3 k# b' a6 g, EEnd With3 R8 z4 N2 S! A7 Z' w% y
" I% @! h U Z% u* v
End If
2 R" |3 A [3 \, v" D% E" p$ Z+ f* ~4 ?
MyName = Dir' }! n) o! D6 Y+ {
! A0 B: B1 W% {4 [3 E" Q$ p& }Loop
3 E$ Z) M k" f
7 M6 j2 ~, j2 M* x5 O. tRange("B1").Select" W! u! s! T7 A& }
' K" E1 U: A, UApplication.ScreenUpdating = True' L4 f" _ c0 u
9 V: m& q) k% z2 V" W, @MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
4 Z0 {* ]. O% `8 L3 u* K/ E6 b2 _0 Y9 V2 O2 ^3 V4 U9 M! _
End Sub |
|
发表于 2020-7-6 10:05:41