VBAでセルのデータ最後の空白を取る

Ａ1-Ａ100の最初と最後が空白の場合、その空白を取ります。
空白を取る前と取った後のデータを作業シートに残します（確認用）。

Sub 前後空白削除_変更行のみ出力()

    Dim wsSrc As Worksheet
    Dim wsWork As Worksheet
    Dim cell As Range
    Dim r As Long
    Dim beforeTxt As String
    Dim afterTxt As String
    Dim hasHeadSpace As Boolean
    Dim hasTailSpace As Boolean
    Dim spacePos As String

    Set wsSrc = ActiveSheet

    ' 作業シート取得（なければ作成）
    On Error Resume Next
    Set wsWork = Worksheets("作業")
    On Error GoTo 0

    If wsWork Is Nothing Then
        Set wsWork = Worksheets.Add
        wsWork.Name = "作業"
    End If

    wsWork.Cells.Clear
    wsWork.Range("A1").Value = "元の氏名"
    wsWork.Range("B1").Value = "前後空白削除後"
    wsWork.Range("C1").Value = "行番号"
    wsWork.Range("D1").Value = "空白位置"

    r = 2

    ' A2:A100 を処理
    For Each cell In wsSrc.Range("A2:A100")

        If cell.Value <> "" Then
            beforeTxt = cell.Value
            afterTxt = beforeTxt

            ' 空白位置判定（削除前）
            hasHeadSpace = (Left(beforeTxt, 1) = " " Or Left(beforeTxt, 1) = "　")
            hasTailSpace = (Right(beforeTxt, 1) = " " Or Right(beforeTxt, 1) = "　")

            ' ★ 空白がなければスキップ
            If Not (hasHeadSpace Or hasTailSpace) Then
                GoTo NextCell
            End If

            ' 末尾の全角／半角空白削除
            Do While Right(afterTxt, 1) = " " Or Right(afterTxt, 1) = "　"
                afterTxt = Left(afterTxt, Len(afterTxt) - 1)
            Loop

            ' 先頭の全角／半角空白削除
            Do While Left(afterTxt, 1) = " " Or Left(afterTxt, 1) = "　"
                afterTxt = Mid(afterTxt, 2)
            Loop

            ' 空白位置文字列
            spacePos = ""
            If hasHeadSpace Then spacePos = "先頭"
            If hasTailSpace Then
                If spacePos <> "" Then
                    spacePos = spacePos & "・末尾"
                Else
                    spacePos = "末尾"
                End If
            End If

            ' 作業シート出力
            wsWork.Cells(r, 1).Value = beforeTxt
            wsWork.Cells(r, 2).Value = afterTxt

            ' 行番号＋ハイパーリンク
            wsWork.Cells(r, 3).Value = cell.row
            wsWork.Hyperlinks.Add _
                Anchor:=wsWork.Cells(r, 3), _
                Address:="", _
                SubAddress:="'" & wsSrc.Name & "'!A" & cell.row

            wsWork.Cells(r, 4).Value = spacePos

            ' 元セル更新
            cell.Value = afterTxt

            r = r + 1
        End If

NextCell:
    Next cell

    MsgBox "空白が削除されたデータのみ出力しました"

End Sub