数据导入

admin

1. Sub TEST()
   ( @" X' @8 l+ L0 i$ x* F0 r8 P
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("scripting.dictionary")
   : |* e* ]6 Y9 }9 G% q  ?, P0 S
4.     MyPath = ThisWorkbook.Path & "\基础数据"
   
5.     MyName = Dir(MyPath & "*.xlsx")
   9 C$ s& L) v" \% m$ ^
6.     Do While MyName <> ""
   1 |, Q2 W2 R/ \4 n: _
7.         If MyName <> ThisWorkbook.Name Then
   5 v- i4 t) J% J1 h( m! ]2 O  P$ G
8.             Set wb = GetObject(MyPath & MyName)
   ; b* J# Z3 _- I& C+ S) @
9.             For Each sh In Sheets
   % w9 ?( k3 c3 m7 H. l2 `% D, ^
10.                 If sh.Name = Split(MyName, ".")(0) Then wb.Sheets(1).Cells.Copy sh.[a1]
    & _1 l1 l( C) V4 A
11.             Next
    8 y- \! x. \$ t3 z- Q
12.             wb.Close False
    
13.         End If
    9 V( q( j3 |- Z- ~2 c
14.         MyName = Dir
    
15.     Loop
    2 e9 N! G" s# y( O1 ?
16.     Application.ScreenUpdating = True
    & F6 _! j( H* B" E/ Y! }' c
17.     MsgBox "文件夹内所有数据已导入！"
    + r. H  V+ F' X
18. End Sub

复制代码

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

2020-4-6 22:33 上传

点击文件名下载附件