数据导入

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

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

x

Sub TEST()
& N' d; u; i( |" I- s- Z5 V
Application.ScreenUpdating = False1 d. M) e5 y$ K1 K! ?; Q
Set d = CreateObject("scripting.dictionary")
. F$ |" n F' H) k
MyPath = ThisWorkbook.Path & "\基础数据"
7 m/ y, u% m( v( p1 ~; `
MyName = Dir(MyPath & "*.xlsx")
Do While MyName <> ""; b* b W/ Q7 O1 _: C' A
If MyName <> ThisWorkbook.Name Then1 u `7 i6 v1 L9 @# [
Set wb = GetObject(MyPath & MyName)8 A& v1 Y3 x; `, j$ X
For Each sh In Sheets
" k' K- U7 ]# R2 S# v. X9 [
If sh.Name = Split(MyName, ".")(0) Then wb.Sheets(1).Cells.Copy sh.[a1]
" n. u- s5 `0 z/ y c! j
Next. b, }+ \; O, [% y- d) t4 B
wb.Close False
4 N# F8 ?7 O* Q6 |) T# W4 z
End If
. C4 R' g/ K6 e! L
MyName = Dir1 E8 F$ g/ j( J; F
Loop0 f! y8 g+ \4 q# i" F* ]3 m
Application.ScreenUpdating = True: m$ ]( v& I. K) S
MsgBox "文件夹内所有数据已导入！"" p& O) y2 T" L; u, _
End Sub

复制代码

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

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

[Excel课程] 数据导入