Makro ile birden fazla alan seçme

Merhaba,

Forum sitesinden yardım alarak excel üzerinde personellerin mola sürelerini otomatik olarak gönderen bir makro yazdım. Makro başarılı bir şekilde çalışmakta ve mail göndermekte. Makro tüm personel listesi içinden personellerin mola süreleri  proje adına göre parça olarak seçim yapıp yöneticilerine mail atıyor. Çözemediğim sorun ise çalışma sayfasındaki başlık alanı olan  A1:C1 aralığını her parçaya eklemesini istiyorum. Tüm range şekillerini denedim eklettiremedim. Makro aşağıdaki gibidir. Yardımlarınızı bekliyorum.

 Sub mail_gonder()
'
' Mail_Gonder
'
Dim satir As Integer
Dim sayac As Integer
Dim fark As Integer
Dim uzunluk As Integer
Dim kisilerto As String
Dim kisilercc As String

  satir = 2
  fark = 2
  sayac = satir + 1
  uzunluk = WorksheetFunction.CountA(Range("B:B"))

For satir = 2 To uzunluk + 1
 
             If Cells(satir, 2) = Cells(sayac, 2) Then
 sayac = satir + 2
             
             
  Else
      kisilerto = WorksheetFunction.VLookup(Cells(satir, 2), Range("Sayfa2!A:C"), 2, False)
      kisilercc = WorksheetFunction.VLookup(Cells(satir, 2), Range("Sayfa2!A:C"), 3, False)
      'ActiveSheet.Range("A1:C1").Select
      ActiveSheet.Range(Cells(fark, 1), Cells(satir, 3)).Select
      
       ' Select the range of cells on the active worksheet.
       'Secimleri üstüne ekleyerek gidiyor 'ActiveSheet.Range("A1:C3", Range(Cells(fark, 1), Cells(satir, 3))).Select

   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
  
   With ActiveSheet.MailEnvelope
      .Introduction = "Merhaba," & Chr(13) & _
       Chr(13) & _
      "Projelerinizin " & Range("E2") & " itibari ile mola kullanım süreleri aşağıdaki gibidir." & Chr(13) & _
 Chr(13) & _
       "Bilginize & İyi çalışmalar." & Chr(13)
      .Item.To = "BURAK BARAN" 'kisilerto
      .Item.cc = "" 'kisilercc
      .Item.Subject = Cells(satir, 2) & " Projesi Mola Kullanım Süreleri"
      .Item.Send
   End With
fark = satir + 1
sayac = satir + 2
ActiveSheet.Range("A1:A1").Select
End If
  Next satir
 
MsgBox "Mailler Gönderilmiştir"
End Sub