EXCEL VBAについて質問です。良い回答は５００～１０００ｐｔを差し上げます。

前段の部分が良く見えませんが、Dir 以降をこんな形にしてどうでしょうか。

Sub japan_nan()

　　　　　：
　　　　　：
　　　　　：

    Dim wb As Workbook
    Dim fileName
    fileName = Dir(p & "\" & "*.xls", vbNormal)
    Do While fileName <> ""
        Set wb = Workbooks.Open(p & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
        mySearch wb, Split(fileName, "・")(1) '// ***・県名・*** から県名を取得
        wb.Close
        fileName = Dir
    Loop
End Sub

Sub mySearch(srcWB As Workbook, prefName)
    Dim productName As String
    Dim wsName
    Dim dstWS As Worksheet
    Dim dstRow As Range
    Dim r As Long
    For Each wsName In Array("大型", "中型", "小型")
        With srcWB.Worksheets(wsName)
            For r = 4 To Rows.Count
                productName = StrConv(.Cells(r, "D"), vbWide)
                If productName = "" Then Exit For
                
                On Error Resume Next
                Set dstWS = ThisWorkbook.Worksheets(productName)
                On Error GoTo 0
                
                If Not dstWS Is Nothing Then
                    dstRow = dstWS.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWS.Cells(dstRow, "B").Value = prefName
                    dstWS.Cells(dstRow, "C").Value = productName
                    dstWS.Cells(dstRow, "G").Value = .Range("J2")
                    dstWS.Cells(dstRow, "H").Value = .Cells(r, "H")
                    Exit Sub
                End If
            Next
        End With
    Next
End Sub

ただ、あるフォルダの中にあるEXCEL ファイルの中から 大型、中型、小型のシートを
順番に見ていき、最初に ThisWorkbook の中のシート名と同じ製品名があったら、それを追記する（2つ目以降を見ない）というのが仕様かどうかが気になりました。

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
下記追記

また、全角変換したデータをシート名と比較していますが、シート名はすべて全角で書かれているのでしょうか。
下記で確認してはどうかと思います。

Sub wideCheck()
    Dim ws As Worksheet
    For Each ws In Worksheets
        If ws.Name <> StrConv(ws.Name, vbWide) Then
            MsgBox "シート名に半角文字が含まれています。"
        End If
    Next
End Sub

アクティブブックの全部のシート名を全角変換するには下記でできます。
うえで引っかかるようでしたら、これを実施した後に最初のコードを実行してみてどうでしょうか。

Sub wideConv()
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Name = StrConv(ws.Name, vbWide)
    Next
End Sub

コメントに提示されたコードは見づらいので下記に掲載しました(一部修正)。

Option Explicit

Private Sub CommandButton1_Click()
    Dim ShellApp As Object
    Dim oFolder As Object
    Dim wb As Workbook
    Dim fileName
    Set ShellApp = CreateObject("Shell.Application")
    Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)
    MsgBox oFolder.Items.Item.Path, vbOKOnly, "フルパス表示！"
    
    Dim p
    p = oFolder.Items.Item.Path
    
    fileName = Dir(p & "\" & "*.xls", vbNormal)
    Do While fileName <> ""
        Set wb = Workbooks.Open(p & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
        mySearch wb, Split(fileName, "・")(1) '// ***・県名・*** から県名を取得
        wb.Close
        fileName = Dir
    Loop

'// ★移動：ThisWorkbook へ対する処理ならこちらで実施すべき
    Application.ScreenUpdating = False
    Dim Sht As Worksheet
    For Each Sht In Worksheets
        Sht.Select
        'Call Nyuryoku
        Call AverageSheet
        'Call ClearCon
        Call SumSheet
        'Call ClearCon
    Next Sht
    Application.ScreenUpdating = True
End Sub
    
Sub mySearch(srcWB As Workbook, prefName)
    Dim productName As String
    Dim wsName
    Dim dstWS As Worksheet
    Dim dstRow As Long
    Dim r As Long
    For Each wsName In Array("大型", "ﾊﾟﾁﾝｺ", "ｽﾛｯﾄ")
        With srcWB.Worksheets(wsName)
            For r = 4 To Rows.Count
                productName = StrConv(.Cells(r, "D"), vbWide)
                If productName = "" Then Exit For
                On Error Resume Next
                Set dstWS = ThisWorkbook.Worksheets(productName)
                On Error GoTo 0
                
                If Not dstWS Is Nothing Then
                    dstRow = dstWS.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWS.Cells(dstRow, "B").Value = prefName
                    dstWS.Cells(dstRow, "C").Value = productName
                    dstWS.Cells(dstRow, "G").Value = .Range("J2")
                    dstWS.Cells(dstRow, "H").Value = .Cells(r, "H")
                    Set dstWS = Nothing '// 一応おまじない
                    ' すべてを検索する場合は①、②とも削除
                    Exit Sub    ' // ①見つけたら次のファイルを検索
                    ' Exit For  ' // ②見つけたら次のシートを検索
                End If
            Next
        End With
    Next
End Sub

各ファイルはシート名に半角文字が使われているようですが、全角・半角の運用は意図通りになっているでしょうか。