数据导入

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

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

x

Sub TEST()
: u7 h' w0 s: ~" J d. z
Application.ScreenUpdating = False7 K! A/ }1 Z) k) t A& V
Set d = CreateObject("scripting.dictionary")1 \! O6 L! {/ R1 @
MyPath = ThisWorkbook.Path & "\基础数据"
+ [9 N8 P. u( l3 b
MyName = Dir(MyPath & "*.xlsx")8 ?# t+ _# ^. ^
Do While MyName <> ""
5 f( x# D# `) J( W7 ~/ u
If MyName <> ThisWorkbook.Name Then
( c( S) B* @' W
Set wb = GetObject(MyPath & MyName)9 {) ?/ n2 Y" A% z9 O+ y3 |! x' x! Z
For Each sh In Sheets9 {) c: g( A {9 d# a8 L
If sh.Name = Split(MyName, ".")(0) Then wb.Sheets(1).Cells.Copy sh.[a1]+ h. ^( D2 _4 C- V: ~7 q
Next: j, Q# |' a' N0 X- y0 w4 N
wb.Close False
6 f4 f% ]1 q% l: k. \
End If" [8 |2 G- Q* d/ Z
MyName = Dir
9 Q' [' E; k" M+ W7 y, e# X" O, O b
Loop
* J- ~% I: t3 P6 o+ D6 @/ c# t
Application.ScreenUpdating = True# u* L& G K, ?6 z" c: t) c
MsgBox "文件夹内所有数据已导入！"4 Y. }0 `" z ]( t3 G
End Sub

复制代码

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

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

[Excel课程] 数据导入