Private Sub CommandButton1_Click() Dim fn As String Dim r As Long r = 1
fn = Dir(ThisWorkbook.Path & \While fn <> \
If fn <> \收集文件.xls\r = r + 1
Cells(r, 1) = fn
Workbooks.Open Filename:=ThisWorkbook.Path & \Worksheets(1).Activate
ActiveSheet.Range(\ThisWorkbook.Activate Cells(r, 2).Select ActiveSheet.Paste Workbooks(2).Save Workbooks(2).Close fn = Dir() End If Wend
ThisWorkbook.Save End Sub
Sub 汇总数据()
Application.ScreenUpdating = False p = \
f = Dir(p & \ Do While f <> \
Workbooks.Open p & f r = r + 1
ActiveSheet.Rows(3).Copy
Workbooks(\汇总.xls\ActiveSheet.Range(\ActiveSheet.Paste
Application.CutCopyMode = xlCut Workbooks(f).Activate
ActiveWorkbook.Saved = True ActiveWindow.Close f = Dir Loop
Application.ScreenUpdating = True End Sub
Private Sub CommandButton1_Click() 'Application.ScreenUpdating = False Dim f As String Dim r As Long Dim p As String
p = ThisWorkbook.Path & \ f = Dir(p & \ Do While f <> \
If f <> \ r = r + 1
Workbooks.Open p & f Sheets(1).Activate
ActiveSheet.Rows(3).Copy
Workbooks(\ ActiveSheet.Range(\ ActiveSheet.Paste
Application.CutCopyMode = xlCut Workbooks(f).Activate
ActiveWorkbook.Saved = True ActiveWindow.Close
f = Dir End If Loop
Application.ScreenUpdating = True End Sub
