HELP.. ENVIO DE EMAIL

Sub Mail_Selection_Outlook_Body()
Respo = MsgBox("Tem certeza de que deseja enviar a Performance das Lojas?", _
    vbYesNo + vbCritical + vbDefaultButton1)
    Title = "Aviso!"
    If Respo = vbYes Then
    GoTo Start
    Else:
    GoTo Fim
    End If
    
Start:
'DEFININDO LOJA(LJ), SUA PASTA E SEU RESPECTIVO EMAIL(EM)
Dim LJ(999) As String
Dim EM(999) As String
'LOJAS
LJ(1) = "Loja 1"
LJ(2) = "Loja 2"
LJ(3) = "Loja 4"
LJ(4) = "Loja 5"
LJ(5) = "Loja 6"

'EMAILs
EM(1) = "loja1@teste.com.br"
EM(2) = "loja2@teste.com.br"
EM(3) = "loja4@teste.com.br"
EM(4) = "loja5@teste.com.br"
EM(5) = "loja6@teste.com.br"

For i = 1 To 999
If LJ(i) = "" Then GoTo SAI

'PROGRAMAÇÃO DE ENVIO DE CADA DA PASTA
'NO SEU PESPECTIVO CORPO DE EMAIL
    Dim source As Range
    Dim dest As Workbook
    Dim myshape As Shape
    Dim OutApp As Object
    Dim OutMail As Object
    Set source = Nothing
    On Error Resume Next
    Sheets(LJ(i)).Select
    'COPIANDO E COLANDO VALORES
    Range("A1:I3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
    'ESCREVENDO EM DETERMINADA CéLULA
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "Segue a performance da " & LJ(i)
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "Atenciosamente,"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "Rafael M.Romano"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "Planejamento e Controle"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "Nativa"
    'NEGRITO
    Range("B8").Select
    Selection.Font.Bold = True
    Range("B9").Select
    Selection.Font.Bold = True
    Range("B10").Select
    Selection.Font.Bold = True
    
    Sheets(LJ(i)).Select
    Range("A1:I10").Select
    Set source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    'VERIFICAÇÕES DE POSSàVEIS ERROS
    If source Is Nothing Then
        MsgBox "A planilha está vazia ou a Pasta está protegida" & _
        vbNewLine & "Por favor, corrija e tente novamente !!", vbOKOnly
        Exit Sub
    End If
    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "Um Erro ocorrido:" & vbNewLine & vbNewLine & _
               "Você tem mais de uma Pasta selecionada." & vbNewLine & _
               "Houve um erro na seleção das células." & vbNewLine & _
               "Ou a programação foi interrompida." & vbNewLine & vbNewLine & _
               "Por favor, corrija e tente novamente !!", vbOKOnly
        Exit Sub
    End If
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    Set dest = ActiveWorkbook
    For Each myshape In dest.Sheets(1).Shapes
        myshape.Delete
    Next
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = EM(i)
        .CC = ""
        .BCC = ""
        .Subject = "Performance da " & LJ(i)
        .HTMLBody = RangetoHTML
        .Send
    End With
    dest.Close False
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set dest = Nothing
    Application.ScreenUpdating = True
'    MsgBox "Mensagem enviada!"
    Sheets(LJ(i)).Select
    Range("B5:B10").Select
    Selection.ClearContents
    Range("A1").Select
    
Next

SAI:
MsgBox "Mensagens enviadas com Sucesso!!" & vbNewLine & vbNewLine & _
       "Um Abraço," & vbNewLine & _
       "Almir Pires", vbOKOnly
Fim:
End Sub

Function RangetoHTML()
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    TempFile = "C:\Temp\Lojas.htm"
    With ActiveWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=TempFile, _
        Sheet:=ActiveSheet.Name, _
        source:=Selection.Address, _
        HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Kill TempFile
End Function