こんなことでしょうか｡

Option Explicit

Sub 集計()
 Dim myWS As Worksheet
 Set myWS = ActiveSheet
 
 Dim wsh
 Set wsh = CreateObject("WScript.Shell")

'// ★ ﾃﾞｽｸﾄｯﾌﾟ上のﾌｫﾙﾀﾞ名を設定 ： ﾃﾞｰﾀﾌｫﾙﾀﾞ を変更
 Dim dtPath
 dtPath = wsh.SpecialFolders("Desktop") & "\ﾃﾞｰﾀﾌｫﾙﾀﾞ"

 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")

 myWS.Columns("B").Font.ColorIndex = 3

 Dim file
 Dim xName
 Dim dstCell As Range
 Dim srcCell As Range
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 For Each file In fso.GetFolder(dtPath).Files
 If InStr(file.Name, ".xls") > 0 Then
 xName = StrConv(Left(file.Name, InStr(file.Name, ".xls") - 1), vbNarrow)
 Set dstCell = myWS.Columns("A").Find(xName, lookat:=xlWhole)
 If dstCell Is Nothing Then
 Set dstCell = myWS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
 dstCell.Value = xName
 End If
 With Workbooks.Open(file.Path)
 Set srcCell = .Worksheets(1).Columns("A").Find("合計")
 dstCell.Offset(0, 1).Font.ColorIndex = 1
 If srcCell Is Nothing Then
 dstCell.Offset(0, 1).Value = "合計がありません"
 Else
 dstCell.Offset(0, 1).Value = srcCell.Offset(0, 1).Value
 End If
 .Close SaveChanges:=False
 End With
 End If
 Next
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
End Sub