macros代码在每一行重复相同的过程

我已经设法创build下面的代码，使用几个不同的互联网search和帮助网站。 它基本上是每行的PDF格式，然后通过电子邮件发送给几个不同的人，也在那一行。 我可以复制代码，用第3行replace第2行等等，但是将会有大约20行，如果我只需要改变一个位就会使代码变得庞大而且很痛苦。

如果任何人可以帮助我需要把前后的代码，使其在每一行循环，将不胜感激！

Sub FinanceAttachActiveSheetPDF() Dim IsCreated As Boolean Dim i As Long Dim PdfFile As String, Title As String Dim OutlApp As Object Sheets(Range("B2") & " Actuals").Select Sheets(Range("B2") & " Actuals").Activate ChDir "G:\Finance\12 Projects\22 Departmental Budget\Monthly PDF's" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Sheets(Range("B2") & " Actuals").Range("G1"), Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False Title = Range("O2") Set emailRng = Worksheets("Email List").Range("C2:H2") For Each cl In emailRng sTo = sTo & ";" & cl.Value Next sTo = Mid(sTo, 2) Set emailRng = Worksheets("Email List").Range("I2:M2") For Each cl In emailRng sTo1 = sTo1 & ";" & cl.Value Next sTo1 = Mid(sTo1, 2) ' Use already open Outlook if possible On Error Resume Next Set OutlApp = GetObject(, "Outlook.Application") If Err Then Set OutlApp = CreateObject("Outlook.Application") IsCreated = True End If OutlApp.Visible = True On Error GoTo 0 ' Prepare e-mail with PDF attachment With OutlApp.CreateItem(0) ' Prepare e-mail .Subject = Title .To = sTo .CC = sTo1 .body = "Hi ," & vbLf & vbLf _ & "Please see attached the actuals vs MAP for your departments performance." & vbLf & vbLf _ & "If you have any queries on the attached or require any further information then please let me know." & vbLf & vbLf _ & "Regards," & vbLf _ & Application.UserName & vbLf & vbLf .Attachments.Add Range("N2").Value ' Try to send On Error Resume Next .Send Application.Visible = True If Err Then MsgBox "E-mail was not sent", vbExclamation Else MsgBox "E-mail successfully sent", vbInformation End If On Error GoTo 0 Sheets("Email List").Select End With ' Quit Outlook if it was created by this code If IsCreated Then OutlApp.Quit ' Release the memory of object variable Set OutlApp = Nothing End Sub