Sub HyoSakuseiMain()
    Dim head As String
    Dim foot As String
    Dim body As String
    Dim CB As New DataObject
    Dim i As Double
    Dim j As Double
    
    head = "<table border=""1""cellpadding=""5"">"
    foot = "</table>"
    body = ""
    
    If Selection.Count = 1 Then
        MsgBox "範囲が選択されていません"
        Exit Sub
    End If
    If MsgBox(Selection(1).Address(False, False) & "〜" & Selection(Selection.Count).Address(False, False) & "が選択されています。処理を行いますか？", _
    vbYesNo + vbQuestion, "確認") = vbYes Then
        For i = Selection(1).Row To Selection(Selection.Count).Row
            body = body + "<tr>"
            For j = Selection(1).Column To Selection(Selection.Count).Column
                body = body & "<td>" & AtaiGet(i, j) & "</td>"
            Next j
            body = body + "</tr>"
        Next i
        With CB
            .SetText head & body & foot
            .PutInClipboard
        End With
        MsgBox "クリップボードに" & head & body & foot & "をコピーしました"
    Else
        MsgBox "やめます"
        Exit Sub
    End If

End Sub

Function AtaiGet(i As Double, j As Double) As String
    If Cells(i, j).Value = "" Then
        AtaiGet = ""
    Else
        AtaiGet = Cells(i, j).Value
    End If
End Function