【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