Below is my code to paste over a range to Outlook to send an email but it is not working properly. Please help.

Private Sub CommandButton1_Click() 'Created by Shenal Salgado     Dim xOutApp As Object     Dim xOutMail As Object     Dim xMailBody As String     Dim rng As Range     On Error Resume Next     Set xOutApp = CreateObject("Outlook.Application")     Set xOutMail = xOutApp.CreateItem(0)     Set rng = sh_main.Range("A1:E26")     xMailBody = sh_main.Range("A1:E26")                   On Error Resume Next     With xOutMail         .To = "xxxxxxxxxx"         .Cc = ""         .BCC = ""         .Subject = "EOD SWAPTION CHECK: " & sh_main.Range("A1")         .Body = xMailBody         .Display     End With     On Error GoTo 0     Set xOutMail = Nothing     Set xOutApp = Nothing End Sub