TA的每日心情 | 难过
2020-11-4 15:03 |
|---|
签到天数: 4 天 [LV.2]偶尔看看I
|
Sub 合并当前目录下所有工作簿的全部工作表()2 c( x& H5 K1 N% l0 m) R0 C! R5 n
" d3 g5 q2 z% w, h4 {, i/ ] TDim MyPath, MyName, AWbName
3 A, P. r( _0 q# n' m
8 g+ A9 y& {$ W8 g' ZDim Wb As Workbook, WbN As String! c7 ~9 Z; C0 e8 k/ S) `$ h
! v3 H6 r; ^3 V5 l8 E- \- U8 m
Dim G As Long' F' c" v6 i4 e7 J$ {) |: z. L
( ^3 [% W' w4 O8 H
Dim Num As Long
, a% ~2 I- H( u3 }8 [* [, r
0 n$ X5 v; N$ u4 GDim BOX As String/ {/ s! H* E5 E
6 G* o2 x2 e; ~" U tApplication.ScreenUpdating = False
, B1 o' Z- r; ~
5 }$ C% w/ A4 \$ ^& l: D7 t% eMyPath = ActiveWorkbook.Path; k/ P; }' f ?5 v
- A7 \5 @6 ~! s8 K8 L
MyName = Dir(MyPath & "\" & "*.xls"), a y7 ~( W8 C) S. U
- Y$ ?5 q6 p1 p+ Z) J
AWbName = ActiveWorkbook.Name
6 {. W# o. w" I! s9 k5 o6 x, P8 e* M, |- A) f# r7 j1 M# W3 G
Num = 0
& R' E1 c3 T H, Q9 {; l- o
; }# O, \# z# |Do While MyName <> ""8 z( l% @/ `1 o
* K: W" x$ _$ Z6 r; `
If MyName <> AWbName Then3 D( Q) j$ [# _0 ?
- ?' v. o" V0 \. y
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
- K. X0 q, Z8 F. A. }, z( P
7 }- x' w: A) d4 W3 T _% ^. j* n' ANum = Num + 12 V5 }( X: Y) }& Z% [6 H y
0 A& I O- H' C
With Workbooks(1).ActiveSheet4 }7 P6 C |4 i5 I9 Z5 u) @
7 |, s/ Z. w! s S$ T- s/ }.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)% `) B$ ?* z1 X6 Y4 o; w! g7 V1 S
9 _6 t6 v& N4 D% U) S, YFor G = 1 To Sheets.Count# b b! N( p9 N8 ]
# {! S- v) H2 y) u! k. N- M4 JWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)/ J: ^# P# v$ o5 ]" H
( x% d# x7 I0 \9 B# a& V
Next. D+ i* `3 R3 f) l8 y4 B& K- v
; |- M. l$ ?; o1 l% A' fWbN = WbN & Chr(13) & Wb.Name
, y9 q$ }; Y: @- f" j" [' c) {5 G1 I) V
Wb.Close False
. u- L. K$ t1 } i: {' L$ h2 N0 r+ Z
End With+ D# Y9 p3 ~% }/ y: z
: {9 z5 ~& J* G: V/ k6 b
End If
8 R! m; Y2 e" n u3 t" S6 [+ a
- W" K7 K/ U9 L- GMyName = Dir
* V1 P4 d( t6 ~7 O) k, e
# ]) E$ K" ]& m v( c: C: QLoop7 d1 [" ?5 z0 X+ ~: E+ y. H
1 L) S6 H9 o c0 r; {" N2 F$ U. SRange("B1").Select
$ B( [$ u, D ]! j- ?1 E5 L7 |8 t& S, q7 d: I
Application.ScreenUpdating = True+ T9 _, V! A# d. q
7 Q' i( U# h" e+ v F- L- O* [
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
( T, D1 |& v w F" @* O4 V0 j/ b$ j: [1 w# P4 u
End Sub |
|
发表于 2020-7-6 10:05:41