Se o seu outro tópico foi resolvido, então marque-o como resolvido: http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=27351&p=136404#p136404

Ao anexar um arquivo aqui no fórum, você facilita o entendimento de quem vai responder.
Não sou especialista em enviar email, mas, pelo que vi por aí, para enviar para mais de um endereço de email, basta que os endereços estejam separados por ponto e vírgula (;)
É o mesmo processo que você já está conseguindo fazer, basta separar os endereços da forma dita acima.
Isso supondo que todos os endereços estejam em uma única célula.

Se cada endereço estiver em uma célula, será necessário fazer um laço de repetição para percorrer cada célula que contenha endereço.

A seguir, alguns sites e vídeos relacionados:

https://www.youtube.com/results?search_query=vba+enviar+email

http://www.planilhando.com.br/forum/search.php?keywords=enviar+email&fid%5B0%5D=10

https://www.google.com.br/search?q=vba+enviar+email&oq=vba+enviar+email&aqs=chrome..69i57j69i59l2j69i60j69i61j69i60.7863j0j7&sourceid=chrome&ie=UTF-8

ROGER-BBD,

Bom dia!

Como o Klarc28 já mencionou, está bem simples de você efetivar a modificação desejada. Vi que você está armazenando na variável Copia o email que está na célula F2 da aba Email. Desse modo, se agora você precisará enviar com cópia para vários outros emails (que estão na coluna G e assinalados com X na coluna E), basta que você altere seu código da seguinte maneira:

Sub Envia_Email()
'Declara Variáveis
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Dest As String
    Dim Email As String
    Dim Copia As String
    Dim Título As String
    Dim Texto As String
    Dim Anexo As String
    Dim WMail As Worksheet
   
'Inicializa Variáveis
    Set WMail = Sheets("E-Mail")
     Titulo = WMail.Range("H2").Value
    Texto = WMail.Range("H8").Value
 
'Desliga Atualização de Tela
    Application.ScreenUpdating = False

'Mostra Planilha E-Mail
    WMail.Visible = True
           
'Analisa Listagem Destinatários
    WMail.Select
    Range("B2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Offset(0, -1) <> "" Then
            Dest = ActiveCell.Value
            Email = ActiveCell.Offset(0, 1).Value
            If ActiveCell.Offset(0, 3) <> "" Then
                   Copia = ActiveCell.Offset(0, 5).Value
            End If
            Anexo = ThisWorkbook.Path & "" & Dest & ".xlsx"

            Set OutApp = CreateObject("Outlook.application")
            Set OutMail = OutApp.CreateItem(0)
           
            With OutMail
                .To = Email
                .CC = Copia
                .Subject = Titulo
                .Body = Texto
                .Attachments.Add Anexo
                .Send
            End With
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
   
'Liga Atualização de Tela
    Application.ScreenUpdating = True
   
'Oculta Planilha E-Mail
    WMail.Visible = False
   
'Oculta Formulário
    frmEmail.Hide
   
'Informa término do envio
    MsgBox "Emails Enviados com Sucesso", vbOKOnly, "Processo Concluído"
   
End Sub

Olá, agradeço a vocês a disponibilidade em ajudar. Para mim que estou começando a poucos dias, sem conhecimentos de lógica de programação e fazendo tudo por conta própria, o apoio de vocês é muito significativo.

Eu já havia tentado incluir um loop com do while, porém o que esta ocorrendo é que a cada loop, ele sobrepõe o destinatário da cópia com o novo endereço de e-mail. Não estou conseguindo resolver isso.

Fiz um código mais simples para testar a rotina em outro arquivo (conforme anexo), separando a rotina do loop da cópia para ficar mais fácil acompanhar a execução. Segue anexo se puderem verificar

 Sub Envia_Email()

'Declara Variáveis
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Dest As String
    Dim Copia As String
    Dim Texto As String
    Dim W As Worksheet
    
'Inicializa Variáveis
    Set W = Sheets("Sheet1")
    Set OutApp = CreateObject("Outlook.application")
    Set OutMail = OutApp.CreateItem(0)
        
'Inicia geração do E-mail
    
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("B1").Value
        .Body = Range("C1").Value
        .Display
    End With
    
'ROTINA DE LOOP PARA INCLUSÃO DE VÁRIO DESTINATÁRIOS C.C.
            Range("d1").Select
            Do While ActiveCell <> ""
                 Copia = ActiveCell.Value
                 OutMail.CC = Copia
                ActiveCell.Offset(1, 0).Select
            Loop
        
    End Sub

Sub Envia_Email()

'Declara Variáveis
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Dest As String
    Dim copia As String
    Dim Texto As String
    Dim W As Worksheet
    'gera a strig copia
    copia = Range("D1").Value
            Range("d1").Select
            Do While ActiveCell <> ""
                 copia = copia & ";" & ActiveCell.Value
                ActiveCell.Offset(1, 0).Select
            Loop

'Inicializa Variáveis
    Set W = Sheets("Sheet1")
    Set OutApp = CreateObject("Outlook.application")
    Set OutMail = OutApp.CreateItem(0)
        
        
'Inicia geração do E-mail
    
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("B1").Value
        .cc = copia
        .Body = Range("C1").Value
        .Display
        .send
    End With
    
        
    End Sub

Você tem razão klarc28 !
É que estou resolvendo situações do meu dia a dia para aprender, e acaba demandando soluções avançadas.
Estou me dedicando bastante para evoluir rápido, vendo vídeos na net, lendo livros, vendo as respostas de fóruns, etc.
Nesse pouco tempo já consegui fazer coisas bastante interessantes, e respostas como a de vocês, tem me ajudado a não ficar travado em algum ponto.
Agradeço Muito.

Sua resposta funcionou perfeitamente.