数据导入

admin · 发表于 2020-4-6 22:32:53

您需要登录才可以下载或查看，没有账号？注册

x

Sub TEST()
& J4 E6 r) M! T% o
Application.ScreenUpdating = False
, `6 a0 m) M9 l. S
Set d = CreateObject("scripting.dictionary"). i3 Q. Q0 J2 r& F. ], }5 F
MyPath = ThisWorkbook.Path & "\基础数据"
+ i- O8 t, n% D/ H9 b [
MyName = Dir(MyPath & "*.xlsx")
5 m1 x9 w) F. U1 d
Do While MyName <> ""9 }# z3 m$ A( H3 u7 Y* [9 b
If MyName <> ThisWorkbook.Name Then" a2 b* J$ c: }3 C& y6 y0 ]7 a$ i. D3 v
Set wb = GetObject(MyPath & MyName)
2 _. h. l8 [- \$ V, V
For Each sh In Sheets
8 J5 F u. K9 o& ?$ A
If sh.Name = Split(MyName, ".")(0) Then wb.Sheets(1).Cells.Copy sh.[a1]
, n$ h% x& M0 s' q
Next/ g9 g5 h* i4 t
wb.Close False
! d# _$ K" q7 Q, C. I
End If
0 F2 o8 }! a+ Q7 [) r1 ], o
MyName = Dir5 [0 Q3 N/ p0 J& c
Loop
/ |0 U/ _1 O9 e
Application.ScreenUpdating = True& j* I6 k7 u/ c4 O$ `' R7 L
MsgBox "文件夹内所有数据已导入！"
% v1 s4 P7 J4 z0 V
End Sub

复制代码

数据导入.zip (249.58 KB, 下载次数: 91)

		自动登录	找回密码
密码			注册

[Excel课程] 数据导入