做的数据导入宏，导入文件在我的电脑桌面上能导入换个地方就倒导不进~求大神看看！！

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

Sub DAORU()


MyNow = Now
'On Error GoTo 0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim CurFile As String
Dim DestWB As Workbook
Dim ws As Object 'Allows for diffrent sheet types
MyoldFile = ThisWorkbook.Name
MyFile = Application.GetOpenFilename("(*.*),*.xls)", , "Please Select Folder")
If MyFile = False Then Exit Sub

DirLoc = CurDir(MyFile) & "\" 'MyPath 'location of files

'Set DestWB = Workbooks.Add(xlWorksheet)
'MyNewFile = ActiveWorkbook.Name
'Workbooks(MyNewFile).Activate
CurFile = Dir(DirLoc & "*.xls")

  m = 0
  n = 0
Do While CurFile <> vbNullString

    Dim origwb As Workbook
    Set origwb = Workbooks.Open(Filename:=DirLoc & CurFile, UpdateLinks:=0, ReadOnly:=True)
    MynewFile = ActiveWorkbook.Name


    Workbooks(MyoldFile).Worksheets("往来数据采集").Range("b3:m51").Offset(n, 0).Value = Workbooks(MynewFile).Worksheets("2关联往来余额").Range("A24:L72").Value

    origwb.Close savechanges:=False '不保存关闭工作簿
    CurFile = Dir 'dir函数

m = m + 4
n = n + 49
Loop
'sjhz1 '调用程序



Application.DisplayAlerts = True
Application.ScreenUpdating = True
'DestWB.Close savechanges:=False '不保存关闭工作簿
'Set DestWB = Nothing

MsgBox Format(Now - MyNow, "hh:mm:ss")
0:
'Sheet1.Activate


End Sub

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：excel求助