TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()) O5 ]& F# i( B- O( m
" T' o; I2 J2 C, SDim MyPath, MyName, AWbName
, g% y9 j) o0 C! d- V
! q/ M" ^* d& K( y* K- |6 VDim Wb As Workbook, WbN As String/ } R5 S; c, l5 w
7 C3 ? O# _$ d7 S/ j7 |/ K! I# pDim G As Long7 Z% E3 K0 q4 ]; R# p
! Y- c( v5 y9 `! d% H
Dim Num As Long. L& x& W( p! X$ E4 X: _
2 i) r+ x' Y+ ]/ B+ k6 A" v( M. ^Dim BOX As String
% b0 T" q4 |+ _5 f* _" x% Q' n- T/ H$ H9 ^5 y. k
Application.ScreenUpdating = False
% S& J& X/ z/ k7 {$ _9 c; ?; f
6 r/ g, a$ d8 S, w1 j! h- hMyPath = ActiveWorkbook.Path6 W/ `( Z( L1 E) o8 [
9 T/ f$ Z( q5 p
MyName = Dir(MyPath & "\" & "*.xls")/ w' w$ ]. ~, A/ E# B/ W
1 Y3 J% D; H/ M8 c8 H9 LAWbName = ActiveWorkbook.Name* b. _1 H; H B( B0 W( a' y
) S* v W. F# X+ `* v7 _3 P# f
Num = 0
1 k4 {* a/ z6 I/ N' j) [1 u+ V! J C* u- _% o; {
Do While MyName <> ""4 F" V0 r1 _, T Q
' T( N9 V- A& r8 L2 U! A7 n) a
If MyName <> AWbName Then
; v( I7 E4 [. {9 I9 D3 M# W
% m9 K4 I5 H6 }$ _) \& }9 v; fSet Wb = Workbooks.Open(MyPath & "\" & MyName)
, X+ t8 E9 O$ q
" {: n+ q6 q, }: R, D' X4 C2 x& ?Num = Num + 1
2 H* O* n% F3 t0 q2 _2 X
: `$ m- s1 g iWith Workbooks(1).ActiveSheet
7 v0 t. f5 r) T! O4 J& o# r% q, g- @% e: O
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
/ J* c/ |: Y; x& B; H; l4 ~! c" ]- o' Z
For G = 1 To Sheets.Count
& n0 R$ `. v m9 e4 V5 X4 {& j" H4 P; g0 Y6 t+ X/ \
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
) e! m: p) Q+ U: h) ]$ C% q0 R+ p6 z8 O" E
Next, d: C% g( v2 y, s# M3 h9 U b
! \" A( a- D! C0 P. G
WbN = WbN & Chr(13) & Wb.Name
) h h: @, H# Q, A. u+ o' v$ t( x7 D
@$ P% A" m4 Q4 I3 PWb.Close False
- ~5 X4 i" Z4 M H1 q/ I1 t) y% n4 x/ V# a8 c$ J1 ^
End With |' y* I7 j. T
' ?% a0 Q# j- k0 ^9 Y+ B6 G s
End If
& E i. h/ |' u8 s1 ~4 r8 A3 {
MyName = Dir( Z( V1 p. k( m$ c3 z
+ n4 M1 V- @! y: S( g- a8 k9 J# C
Loop
) g3 o0 a6 C$ d4 j* h
, I) `( O" a# p% ?; d0 z, q; cRange("B1").Select
. |. B1 o6 e7 l, S; b# X# l2 T
! K8 U7 P8 ], AApplication.ScreenUpdating = True
# g4 K& I) o! |
$ w" [8 Z( l$ _) X% R8 `2 h0 nMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示". s+ P! s9 R5 X8 t3 s5 |' l
* D4 [9 M+ w( }' {; F
End Sub |
|
发表于 2020-7-6 10:05:41