1.打开excel2007，点击审阅-宏-输入一个任意名称-创建-输入下面的代码：
Private Sub CommandButton1_Click()
Dim Sh As Worksheet, MyName$, n%
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ThisWorkbook.Sheets.Count > 1 Then
If MsgBox("重新导入报表将删除原来报表，继续吗？ ", 52, "警告") = 7 Then Exit Sub
End If
On Error Resume Next
For Each Sh In Worksheets
If Sh.Name <> ActiveSheet.Name Then
Sh.Delete
End If
Next
n = 1
MyName = Dir(ThisWorkbook.Path & "\*.xls")
Range("a2:b65536").ClearContents
Range("a2:b65536").Hyperlinks.Delete
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & MyName
ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(n)
n = n + 1
ThisWorkbook.Sheets(n).Name = Left(MyName, InStr(MyName, ".") - 1)
Range("a" & n) = n - 1
Me.Hyperlinks.Add Range("b" & n), Address:="", SubAddress:="'" & ThisWorkbook.Sheets(n).Name & "'!A1", ScreenTip:=ThisWorkbook.Sheets(n).Name, TextToDisplay:=ThisWorkbook.Sheets(n).Name
ActiveSheet.Hyperlinks.Add ActiveSheet.Range("p1"), Address:="", SubAddress:=Sheets(1).Name & "!A1", ScreenTip:="返回首页", TextToDisplay:="返回"
Workbooks(MyName).Close
End If
MyName = Dir
Loop
Me.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
2.退出-运行该宏即可解决。
