Excel Dosyasından Mail Gönderme Hk.

[selcukerd]

Excel üstadlarım merhaba,

http://dosya.web.tr/KY1YeK adresine yüklediğim dosyada şöyle bir şey istiyorum: Butona bastığımda hücrede bulunan TC Kimlik numaralarına göre ve her bir kişi için ayrı ayrı sayfa oluşturup hücreye eklediğim mail adresine göndersin. Oluştururken word veya pdf dosyasına dönüştürmesi herhangi bir sıkıntı oluşturmaz. Teşekkür ederim.

 

[selcukerd]

Yardım edebilecek yok mu?

 

[askm]

Aşağıdaki kodlar ile sayfa oluşturuluyor.
Sub Sayfalara_Aktar()

Dim S1 As Worksheet, S2 As Worksheet, i As Long, syf As String, son As Long

Set S1 = Sheets("KURS BİLGİLERİ") 'verilerin bulunduğu sayfa

Application.ScreenUpdating = False
S1.Select

For i = 7 To Cells(Rows.Count, "O").End(xlUp).Row


syf = Trim(S1.Cells(i, "O"))
If varmi(syf) Then 'sayfa mevcut ise sil yeniden oluştur
Application.DisplayAlerts = False
Sheets(syf).Delete
Application.DisplayAlerts = True
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = syf

S1.Range("AG5:AP28").Copy Sheets(syf).Range("A5")


Else 'sayfa mevcut değilse ekle
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = syf
S1.Range("AG5:AP28").Copy Sheets(syf).Range("A5")



End If

Sheets(syf).Range("F12:J12") = S1.Cells(i, "O")
Sheets(syf).Range("F11:F11") = S1.Cells(i, "AF")

Next i

S1.Select
MsgBox "İşlem Tamam"
Application.ScreenUpdating = True

End Sub
Function varmi(adi As String) As Boolean
On Error Resume Next
varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[selcukerd]

Teşekkür ederim Hocam. Peki masaüstüne pdf dosyası olarak kaydedebilir miyiz?

 

[askm]

http://www.excel.web.tr/f48/aktif-sayfayy-masaustune-pdf-olarak-farkly-kaydetme-t111850.html
bu linki inceleyin

 

[selcukerd]

Teşekkür ederim Hocam.