Macro enviar correo desde excel

Tengo este código pero en lugar de enviarme solo la página de excel en la que me encuentro por PDF me convierte el libro a pdf y lo envía.

Sub EnviarArchivo()

'Por. Dante Amor

'

    correo = "[email protected]"

    passwd = "pwd"

    nombre = "archivo.pdf"

    '

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    ruta = ThisWorkbook.Path & "\"

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

        Filename:=ruta & nombre, Quality:=xlQualityStandard, _

        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    '

    Dim Email As CDO.Message

    Set Email = New CDO.Message

    Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"

    Email.Configuration.Fields(cdoSendUsingMethod) = 2

    With Email.Configuration.Fields

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)

        .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo

        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

    End With

    With Email

        .To = "[email protected]; [email protected]"

        .From = correo

        .Subject = "asunto de mensaje"

        .TextBody = "Cuerpo del coreo"

        .AddAttachment ruta & "archivo.pdf"

        .Configuration.Fields.Update

        On Error Resume Next

        .Send

    End With

    If Err.Number = 0 Then

        MsgBox "El mail se envió con éxito"

    Else

        MsgBox "Se produjo el siguiente error: " & Err.Number & " " & Err.Description

    End If

    Set Email = Nothing

End Sub