如果其他的Excel文件都在同壹個目錄中,
加個模塊,復制下面的代碼:
'****************************************************************
'功能:查找指定文件夾含子文件夾內所有文件名(含路徑)
'函數名:?FileAllArr
'參數1:Filename需查找的文件夾名?不含最後的"\"
'參數2:FileFilter?需要過濾的文件名,可省略,默認為:[*.*]
'參數3:Liwai剔除例外的文件名,可省略,默認為:空,壹般為:ThisWorkbook.Name
'返回值:?壹個字符型的數組
'使用方法:arr?=?FileAllArr(ThisWorkbook.Path,?"*.xls",?ThisWorkbook.Name)
Public?Function?FileAllArr(ByVal?Filename?As?String,?Optional?ByVal?FileFilter?As?String?=?"*.*",?Optional?ByVal?Liwai?As?String?=?"")?As?String()
Set?Dic?=?CreateObject("Scripting.Dictionary")'創建壹個字典對象
Set?Did?=?CreateObject("Scripting.Dictionary")
Dic.Add?(Filename?&?"\"),?""
i?=?0
Do?While?i?<?Dic.Count
Ke?=?Dic.keys'開始遍歷字典
MyName?=?Dir(Ke(i),?vbDirectory)'查找目錄
Do?While?MyName?<>?""
If?MyName?<>?"."?And?MyName?<>?".."?Then
If?(GetAttr(Ke(i)?&?MyName)?And?vbDirectory)?=?vbDirectory?Then'如果是次級目錄
Dic.Add?(Ke(i)?&?MyName?&?"\"),?""?'就往字典中添加這個次級目錄名作為壹個條目
End?If
End?If
MyName?=?Dir'繼續遍歷尋找
Loop
i?=?i?+?1
Loop
i?=?0
Dim?arrx()?As?String
For?Each?Ke?In?Dic.keys?'以查找總表所在文件夾下所有excel文件為例
MyFileName?=?Dir(Ke?&?FileFilter)?'過濾器:EXCEL2003為:*.xls,excel2007為:*.xlsx
Do?While?MyFileName?<>?""
If?MyFileName?<>?Liwai?Then?'排除例外文件
ReDim?Preserve?arrx(i) arrx(i)?=?Ke?&?MyFileName i?=?i?+?1End?If
MyFileName?=?Dir
Loop
Next
FileAllArr?=?arrx
End?Function
'****************************************************************
可以在 Sheet1的代碼中寫
Sub?OPIONA()?'//函數實例Dim?sP?As?String,?WB?As?Workbook
sP?=?"E:\VB合並同規格Excel\tmp"?'很多Excel文件的路徑,不含最後的\
arr?=?FileAllArr(sP,?"*.xls",?ThisWorkbook.Name)
Application.ScreenUpdating?=?False
For?i?=?0?To?UBound(arr)
'MsgBox?arr(I)
Set?WB?=?Workbooks.Open(arr(i))
'妳的代碼
ThisWorkbook.Worksheets(1).Cells(i?+?1,?1).Value?=?WB.Worksheets(1).Range("T1000").End(xlUp).Value
WB.Windows(1).Visible?=?False
WB.Close?False
Next
Application.ScreenUpdating?=?True
End?Sub
以上文件路徑需要自己更改,主要取數的代碼解釋如下:
ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value = WB.Worksheets(1).Range("T1000").End(xlUp).Value
從打開文件的T列最後壹個數值取值 ? 賦值給操作表的Sheet1中的單元格。
如果數據在每壹個Excel中的位置是固定的,比如T10,代碼可以直接改為:
ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value = WB.Worksheets(1).Range("T10").Value