Office 2003 VBA 遍历目录下的Excel批量拷贝Sheet 组成一个大的Excel文件

怡木8302

Private Sub Workbook_Open()
Application.DisplayAlerts = False
For Each sh In Me.Sheets
If Me.Sheets.Count > 1 Then
sh.Delete
End If
Next
cp2workbook
End Sub
Sub cp2workbook()
Dim wb As Workbook
Dim i As Long
Dim t
Dim i As Integer
t = Timer
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.SearchSubFolders = True
.Filename = "*.xls"
' .FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
'On Error Resume Next
'Cells(i, 1) = .FoundFiles(i)
Dim wkbk As Workbook
If InStr(.FoundFiles(i), "all") < 1 And InStr(.FoundFiles(i), "template") < 1 Then
i = i + 1
Set wkbk = Workbooks.Open(.FoundFiles(i))
Set wind = wkbk.Windows(1)
wind.Visible = False
wkbk.Sheets(1).Copy ThisWorkbook.Sheets(i)
End If
Next i
Me.Save
Else
MsgBox "No Found"
End If
End With
MsgBox Timer - t
MsgBox i
End Sub