VBA搜索当前目录下所有excel文件中的以“19801”开头的数字内容并全部汇总另存到一个新的EXCEL里，求高手

一个文件夹下有很多个EXCEL文件，每个文件里都有1980100011这样的字符串，我想把所有以19801开头的字符串都汇总并另存为一个新的EXCEL。求高手帮助谢谢。

放到新工作簿中，因为下面代码不汇总代码所在的工作簿。

Sub 汇总()
Dim Path As String, Spath As String
Dim Sh As Worksheet, Folder As Object
Dim N As Double, Num As Long
Dim R1 As Range, R As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path & "\"
Spath = Dir(Path & "*.xls*")
Do While Len(Spath)
If Spath = ThisWorkbook.Name Then Spath = Dir()
With Workbooks.Open(Path & Spath)
For Each Sh In .Worksheets
Set R1 = Sh.Cells.Find("19801", lookat:=xlPart)
If R1 Is Nothing Then GoTo L1
Set R = R1
Do
N = N + 1
Set R = Sh.Cells.Find("19801", R, lookat:=xlPart)
Range("A" & N).Value = R.Value
Loop Until R1.Address = R.Address
L1:
Next
.Close False
End With
Spath = Dir()
DoEvents
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "完成"
End Sub

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息