提取本文件夹下指定工作薄中各表数据

鄂龙蒙

请教：提取本文件夹下指定工作薄中各表数据，到本工作薄的新生成的各表中的代码。谢谢！

1. Sub 提取本文件夹下指定工作薄中各表数据()
   
2.     Dim m, n
   
3.     Dim MyPath, MyName, wb As Workbook
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.    
   
7.     For Each sh In Sheets
   
8.         If sh.Name <> "操作表" Then sh.Delete
   
9.     Next
   
10.    
    
11.     MyPath = ThisWorkbook.Path & ""
    
12.     MyName = Dir(MyPath & "测试工作薄.xlsx")
    
13.             Set wb = Workbooks.Open(MyPath & MyName)
    
14.             m = wb.Sheets.Count
    
15.             With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1)
    
16.                 For n = 1 To m
    
17.                     Set sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
    
18.                     sh.[a1] = wb.Sheets(n).[a1]
    
19.                     sh.Name = n
    
20.                 Next n
    
21.             End With
    
22.             wb.Save
    
23.             wb.Close
    
24.             Set wb = Nothing
    
25.     Application.DisplayAlerts = True
    
26.     Application.ScreenUpdating = True
    
27. End Sub

复制代码

提取本文件夹下指定工作薄中各表数据.rar (22.25 KB, 下载次数: 24)

2017-5-6 09:07 上传

点击文件名下载附件

qingc0221

MyPath = ThisWorkbook.Path & "\"

鄂龙蒙

qingc0221 发表于 2017-5-6 09:36
MyPath = ThisWorkbook.Path & "\"

谢谢您！复制代码时看不到了“\”，能运行，主要是新建工作表上的问题。

鄂龙蒙

qingc0221 发表于 2017-5-6 09:36
MyPath = ThisWorkbook.Path & "\"

Set sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)

这句代码不对。

lsc900707

鄂龙蒙 发表于 2017-5-6 09:50
Set sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)

这句代码不对。

Sub 提取本文件夹下指定工作薄中各表数据()
    Dim m, n
    Dim MyPath, MyName, wb As Workbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    For Each sh In Sheets
        If sh.Name <> "操作表" Then sh.Delete
    Next
   
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "测试工作薄.xlsx")
    Set wb = Workbooks.Open(MyPath & MyName)
    Set wk = ThisWorkbook
    m = wb.Sheets.Count
    For n = 1 To m
        Set sh = wk.Sheets.Add(after:=wk.Sheets(wk.Sheets.Count))
        sh.[a1] = wb.Sheets(n).[a1]
        sh.Name = wb.Sheets(n).Name
    Next n
    wb.Save
    wb.Close
    Set wb = Nothing: Set wk = Nothing: Set sh = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub