【VBA】从批量excel文件中获取数据

需求：从命名规则的批量data文件中提取固定单元格的值，并拷贝到另一个excel中，进行统计

步骤：

1、打开report文件，弹出对话框，开始

2、依次打开命名规则的的data文件n

3、获取固定单元格数据并赋值给report文件的sheet1的A列（data序号）和B列（data）

4、关闭data文件

5、返回循环

6、结束

代码文件：点击下载

日期：2020-12-01 09:31:37

Sub getvaluefromfile()
\'
\' get RTC frequency from excel files
\'

\'
    Dim path As String
    Dim file As String
    Dim Formula As String
    Dim sheetname As String
    Dim cellname As String
    Dim cellnum As String
        
    Dim icount%
    
    Dim WB_origin As Workbook
    Dim sheet_origin As Excel.Worksheet
    Dim originname As String
    
    Dim WB_target As Workbook
    Dim sheet_target As Excel.Worksheet
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        icount = 0
        originname = "2020" \'the name character of data files is 2020
        
        path = Application.ActiveWorkbook.path & "\"  \'get data files path
        file = Dir(path & "*.xls")  \'get the first excel file name
        
        If InStr(file, originname) <> 0 Then \'if it is data file, then open it
            Set WB_origin = Workbooks.Open(path & file)
        Else
            MsgBox "Start to open report file automatically,OK?"
            Set WB_target = Workbooks.Open(path & file)
        End If
         
        Do Until file = ""
            If InStr(file, originname) <> 0 Then \'
                icount = icount + 1
                Set WB_origin = CreateObject(path & file)
                \'Set sheet_origin = WB_origin.Worksheets(1)
                sheetname = Mid(file, 1, 19)
                
                cellname = "B" & icount
                cellnum = "A" & icount
                WB_target.Sheets(1).Range(cellnum).value = icount  \'fill in the number
                WB_target.Sheets(1).Range(cellname).value = WB_origin.Sheets(sheetname).Range("E51").value \'fill in the RTC frequency
                
                Workbooks(file).Close SaveChanges:=False
            Else
                If icount > 1 Then MsgBox "Not data file,jump?"
            End If
            
            file = Dir
        Loop
        MsgBox "Finished ! In total " & icount & " files"
        Application.ScreenUpdating = True
         

End Sub