MACRO ENVIA EMAIL DE ACORDO COM A LOJA

Question

Tenho um arquivo que hoje ele extrai a receita diretamente do SQL e envia todo o relatório para um grupo de emails. 

Eu preciso que esse envio seja feito para um grupo especifico de acordo com a loja selecionada. Meu arquivo é simples. Possui uma segmentação de dados com as lojas e uma tabela dinâmica com a venda aberta por dia. Segue MACRO que utilizo atualmente.

Sub CriarArquivo()
On Error GoTo Erro

Dim Arquivo As Workbook
Dim Plan As String
Dim DataFile As Date

DataFile = WorksheetFunction.Max(Sheets("Relatorio").Range("I:I"))

Plan = "Relatorio"

Set Arquivo = Application.Workbooks.Add

ThisWorkbook.Sheets(Plan).Copy Before:=Arquivo.Sheets(1)

Arquivo.SaveAs ThisWorkbook.Path & "\" & Plan & "_" & Replace(DataFile, "/", "-") & ".xls"

Arquivo.Close

Dim MyOlapp As Object, MeuItem As Object
Set MyOlapp = CreateObject("Outlook.Application")
Set MeuItem = MyOlapp.CreateItem(olMailItem)
With MeuItem
    .Display
    .to = ("[e-mail]")
    .Subject = "RELATORIO de Vendas até" & " " & Replace(DataFile, "/", "-")
    .HTMLBody = "Segue relatório de vendas até " & Replace(DataFile, "/", "-") & "." & .HTMLBody
    .Attachments.Add ThisWorkbook.Path & "\" & Plan & "_" & Replace(DataFile, "/", "-") & ".xls"
    .Display
    '.Send
End With

MsgBox "Nome do Arquivo: " & Plan & "_" & Replace(DataFile, "/", "-"), vbInformation, "Enviado com sucesso!"

Exit Sub

Erro:
MsgBox "Erro!", vbCritical


End Sub