Çözüldü ListBoxta seçtiğim sayfa adını değiştirme ve mail gönderme

Private Sub Label4_Click()
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Sheets(ListBox1.List(i, 1)).Name = "Elma"
        End If
    Next i
End Sub

Private Sub Label4_Click()
    ad = Application.InputBox("Yeni Sayfa Adını Yazın", "SAYFA ADI DEĞİŞİKLİĞİ")
    If ad <> "" Then
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                Sheets(ListBox1.List(i, 1)).Name = ad
                ListBox1.List(i, 1) = ad
            End If
        Next i
    End If
End Sub

Private Sub Label5_Click()

If ListBox1.Selected(i) = True Then
                Sheets(ListBox1.List(i, 1)).Copy
                           End If
With ActiveWorkbook
         .SendMail Recipients:="", _
          Subject:=""
         End With
MsgBox "Mail gönderildi"
End Sub

If ad <> "" And ad <> False Then

Private Sub Label5_Click()
    Dim i%, a%, dosya$, yeni As Workbook, out As Object, mail As Object, syf()
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve syf(a)
            syf(a) = ListBox1.List(i, 1)
            a = a + 1
        End If
    Next i
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets(syf()).Copy
    Set yeni = ActiveWorkbook
    dosya = ThisWorkbook.Path & "\mail.xls"
    yeni.SaveAs Filename:=dosya, FileFormat:=xlNormal
    yeni.Close
    Set out = CreateObject("Outlook.Application")
    Set mail = out.CreateItem(0)
    With mail
        .To = "info@excelarsivi.com"
        .cc = "destek@excelturkey.com"
        .Subject = "ListBoxta Seçilen Sayfaları Mail Atma"
        .body = "Excel Turkey Forum Sunar.."
        .attachments.Add dosya
        .display ' --> Ekrana getirir.
        '.Send   ' --> Gönderir.
    End With
    'İstenirsa aşağıdaki satır aktif edilip mailden sonra oluşan dosya silinebilir.
    'Kill dosya
    Application.ScreenUpdating = True
    i = Empty: a = Empty: dosya = vbNullString: Erase syf
    Set yeni = Nothing: Set out = Nothing: Set mail = Nothing
End Sub