Macro para Envío de Correos en excel.

ya tengo la macro me funciona bien pero al quererla aplicar en otro libro con diferentes parámetros no me trabaja bien.quiero que la macro me agarre desde A1 hasta AB8 el titulo y un elemento. Y que envíe los correos correspondientes lo máximo de correos serán de 100 y empiezan en la casilla ac8.

Sub Enviar()
On Error GoTo salida
pase = MsgBox("Está seguro de hacer mailing masivo???", vbYesNo, "ATENCIÓN")
If pase = vbNo Then Exit Sub
Range("j65000").End(xlUp).Offset(1, 0).Value = "end"
Range("j7").Select
Do While ActiveCell.Value <> "end"
If ActiveCell.Value <> "" Then '1
ubica = ActiveCell.Address
para = ActiveCell.Value
Nombre = ActiveCell.Offset(0, -7).Value
Range("a6:i" & Range("a65000").End(xlUp).Row).Select
Selection.AutoFilter field:=3, Criteria1:=Nombre, Operator:=xlFilterValues
'+++++++++++++++++++++++++++
Range("a515").End(xlUp).Select
Do While ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
fin = ActiveCell.Offset(-1, 0).Row
Range(inicio & "a6:i" & fin).CopyPicture
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
parte2.to = para
parte2.Subject = "Estado de Cuenta Club Tiburones de Honduras"
parte2.body = "Adjuntamos información"
parte2.display
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "^{END}", True
Application.SendKeys "^v", True
Application.Wait Now + TimeValue("00:00:03")
parte2.send
Range("a6").AutoFilter
Range(ubica).Select
ActiveCell.Offset(1, 0).Select
Else '1
ActiveCell.Offset(1, 0).Select
End If '1
Loop
ActiveCell.ClearContents 'borramos la palabra end
Exit Sub
salida:
MsgBox "ha ocurrido algún error revise la información y las instrucciones"
End Sub