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

Question

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

Answer 1

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

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追问

。有一行报错了。Range("A" & N).Value = R.Value 这句 报错信息是 方法'Range'作用于对象'_Global'时失败。

追答

放在某个表里面，不要放模块中。