【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