VBA 将与当前工作表名称一样的外部工作簿的数据复制到这个工作表

问题遇到的现象和发生背景

想要写一个VBA程序，如果外部工作簿的名称与当前工作表的名称一样，就复制外部excel的数据到当前sheet
进阶版是，如果外部excel名字左边数第一个下划线左边的字符与当前sheet名字一致，就复制外部excel数据到当前sheet (头疼了很久一直写不出来）

问题相关代码，请勿粘贴截图

Option Explicit
Sub test()
Dim d As Object, p$, f$, Sh As Worksheet
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
For Each Sh In Worksheets
If Sh.Name <> "集团汇总" Then d(Sh.Name) = ""
Next
p = ThisWorkbook.Path & ""
f = Dir(p & ".xls")
Do While f <> ""
If f <> ThisWorkbook.Name Then
With Workbooks.Open(p & f, 0)
For Each Sh In .Worksheets
With Sh
If d.Exists(.Name) Then .Cells.Copy ThisWorkbook.Worksheets(.Name).Range("A1")
End With
Next
.Close 0
End With
End If
f = Dir
Loop
Set d = Nothing
Application.ScreenUpdating = True
End Sub

运行结果及报错内容

程序是在网上找的，但是这个程序的思路是找到外部excel的sheets 名称与当前工作表匹配
我想实现的是匹配外部excel名字与当前sheets 并复制数据

我的解答思路和尝试过的方法

我想要达到的结果

用宏录制一下，再修改，原文修改容易出错。