TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()
0 W/ K7 m+ r1 A6 P
. f0 r5 f5 d6 G5 o$ K4 P6 cDim MyPath, MyName, AWbName
7 |* U6 u6 s1 e$ r
: r( j3 |% q" V: RDim Wb As Workbook, WbN As String- ^, t; }) |* `" ]8 M
" r6 Y S! j/ o. p/ O8 N' [& r: lDim G As Long
: \+ l" \+ C+ M" M+ o
; Z: J! B7 `% a% n/ [+ q$ d# n7 g; BDim Num As Long
. v" `* [3 c/ R9 j0 m4 M9 U! Q( C4 Y& w% c) ]
Dim BOX As String
5 a4 X; b9 ?) L4 h- f# r
$ P9 j! Z5 j+ w5 H, x/ U' r P7 pApplication.ScreenUpdating = False
% F4 |9 t. s4 y+ X8 n; i3 b7 p* y8 C* ?
MyPath = ActiveWorkbook.Path1 y" _5 O' m, U1 Q
) z- ~0 {$ ~ F- U0 A ]" `4 c4 }
MyName = Dir(MyPath & "\" & "*.xls")
2 E- ]! Q1 I8 B0 _0 B2 W6 ?* \2 V9 A$ t" F; a) Z
AWbName = ActiveWorkbook.Name- j5 S/ g: v, z3 G4 _' E9 ?" s& c
5 V- I1 f9 r- ^1 l+ ~Num = 0! A+ ]2 W! m) Y8 e+ r+ r
I- p! F( V8 v/ w9 `9 ^, e$ t
Do While MyName <> ""3 I* M+ ~% @; V
e+ w, `5 @3 A) P' V( k: U' H$ g' a0 M
If MyName <> AWbName Then& a! l. c- Z/ ]# E" j
: @* d* J$ r4 ^6 @0 J+ O. J
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
- x( @! x5 m& b. S. @- ]7 V
+ r4 k9 M5 f2 F. o) Y% JNum = Num + 1
( h4 S$ }+ [+ ^6 t* \
: W5 K/ A; K, dWith Workbooks(1).ActiveSheet
& x, L, W3 V. Z
" u$ i4 A- ?% ~- |. l/ {- {3 W.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)# e% f* ~' {( l' o3 g" [+ u+ I
! Z d. h3 C' X7 {6 B0 VFor G = 1 To Sheets.Count
4 Q9 X: T0 H2 G& `( S
" h" Y( u' O. j: H- aWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)9 w+ T& ~* n+ ]" L5 k+ D _# e" |
/ O8 A' t; B7 P4 T/ t. p+ XNext" l! } \/ N$ t' ]/ p+ U& W
9 W. C& l% l( q8 ]( I3 F
WbN = WbN & Chr(13) & Wb.Name
( l; k- }# s: F- R: c4 k5 P G/ V7 m3 |. C7 M: B! ]1 J" c
Wb.Close False
; Y* x# y( r7 J$ ]( U" p5 @6 w- B7 V& a& j1 ~2 l2 v5 z
End With) U' }; d( N# m. d. h4 g9 g% ^
1 L8 h- ^8 z0 W7 G( _2 S( v; gEnd If
/ k' D( j% I/ y; w& p; A/ R" c
MyName = Dir
, {0 R2 o$ x3 A1 U
# n+ M' I# `( K9 E6 U9 qLoop' ]5 L: N& [( E |$ p
; M7 I6 H7 ]% F vRange("B1").Select! w* H: ?0 }2 r& s
3 }; D8 K) u) u7 G; h
Application.ScreenUpdating = True
, e$ k4 ^6 u! H7 w$ {* @9 U0 \0 T
# T# D0 E' a4 i2 [5 C4 A7 {$ KMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"& N! n/ U) E9 J$ g( W) I
/ c' h! U3 r! {. H! a1 nEnd Sub |
|
发表于 2020-7-6 10:05:41