韩国店名:关于一个excel vb 下标越界的问题

Private Sub CommandButton1_Click()
Dim TempLen As Byte
Dim TempCount As Integer
Dim strTempPath As String, ViceName As String
Dim fFile As FileSearch
Dim TempMsgBox As VbMsgBoxResult
Set fFile = Application.FileSearch
With fFile
.LookIn = "E:\EXCEL\Origin\第4章\快速汇总多个工作簿"
.Filename = "*.xls"
If .Execute > 0 Then
TempMsgBox = MsgBox("共有" & .FoundFiles.Count & "个文件将被汇总", vbOKCancel, "记数")
If (TempMsgBox = vbCancel) Then
End
End If
TempCount = 1
Do
strTempPath = .FoundFiles(TempCount)
Debug.Print strTempPath
TempLen = Len(strTempPath)
ViceName = Mid(strTempPth, Len(fFile.LookIn) + 2, TempLen - Len(fFile.LookIn) - 1)
Workbooks.Open strTempPath
Workbooks(ViceName).Sheets("Sheets1").Activate
Workbooks(ViceName).Sheets("sheet1").Range("A2:I2").Copy
Workbooks("快速汇总多个工作薄.xls").Sheets("Sheets1").Activate
Cells(Range("A2").Offset(TempCount, 0).Row, 1).Select
Selection.PasteSpecial Paste:=xlValues
Workbooks(ViceName).Close
TempCount = TempCount + 1
Loop Until TempCount > .FoundFiles.Count
Else
TempMsgBox = MsgBox("目标路径下没有需要汇总的Excel文件", vbOKOnly, "提示")
End If
End With
End Sub

提示 Workbooks(ViceName).Sheets("Sheets1").Activate
下标越界 如何改正呢
其实我想做的就是一个宏命令可以合并几个表的总计项做成一个新表
本来想先做到合并再解决其他问题 没想到卡住了
欢迎大家帮忙