求助：用VBA把文件夹下所有excel表集中在一个文件中

看起来有点长，但不需要修改：
Sub copysheet1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
BkName = ActiveWorkbook.Name
For i = Sheets.Count To 2 Step -1
Sheets(i).Delete
Next i
MsgBox "请选择 Excel文件 的路径！"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
folderspec = .SelectedItems(1)
If Right(SavePath, 1) <> "\" Then
folderspec = folderspec + "\"
End If
End With
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
sc = 1
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Then
fName = folderspec + f1.Name
sName = Left(f1.Name, Len(f1.Name) - 4)
Workbooks.Open fName
Sheets("Sheet1").Copy After:=Workbooks(BkName).Sheets(sc)
sc = sc + 1
Sheets(sc).Name = sName
If Workbooks(2).Name <> BkName Then
Workbooks(2).Close
End If
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "复制完毕！请保存。"
Application.FileDialog(msoFileDialogSaveAs).Show
End Sub