テキスト形式の罫線要素を用いた表をEXCELに貼り付けるマクロ

┏━┳━━━━┯━━━━┯━━━━┯━━━━┓
┃　┃Ａ　　　│Ｂ　　　│Ｃ　　　│Ｄ　　　┃
┣━╋━━━━┿━━━━┿━━━━┿━━━━┫
┃１┃　　　　│晴れ　　│曇り　　│雨　　　┃
┠─╂────┼────┼────┼────┨
┃２┃晴れのち│=$A2&B$1│=$A2&C$1│=$A2&D$1┃
┠─╂────┼────┼────┼────┨
┃３┃曇りのち│=$A3&B$1│=$A3&C$1│=$A3&D$1┃
┠─╂────┼────┼────┼────┨
┃４┃雨のち　│=$A4&B$1│=$A4&C$1│=$A4&D$1┃
┗━┻━━━━┷━━━━┷━━━━┷━━━━┛

Sub クイズで学ぶEXCEL貼付け()
'
    Dim moji(50) As String

'クリップボードの中身を貼付け
    ActiveSheet.Paste

'データを配列に読み込んで削除
    ys = Selection.Row
    xs = Selection.Column
    ye = ys + Selection.Rows.Count - 1

    i = 1
    For y = ys + 3 To ye
        dmy = Cells(y, xs).Text
        If Not (InStr(1, dmy, "─") > 0 Or InStr(1, dmy, "━") > 0) Then
            moji(i) = Cells(y, xs).Text
            i = i + 1
        End If
    Next y
    ie = i

    Selection.Delete

'データの中身をセルに分配しながら再貼付け
    For i = 1 To ie
        dmy = "": k = 1
        mend = Len(moji(i))
        For m = 1 To mend
            hitomoji = Mid(moji(i), m, 1)
            If (hitomoji = "┃" Or hitomoji = "│") Then
                If k > 2 Then
                    Cells(ys + i - 1, xs + k - 3).Value = Trim(dmy)
                End If
                k = k + 1
                dmy = ""
            Else
                dmy = dmy + hitomoji
            End If
        Next m
    Next i
    Cells(ys, xs).Select
End Sub