tirEdsOuL
Altın Üye
- Katılım
- 3 Şubat 2009
- Mesajlar
- 326
- Excel Vers. ve Dili
- Office 2016
- Altın Üyelik Bitiş Tarihi
- 24-08-2026
Arkadaşlar Merhaba;
Emir Hüseyin Çoban hocamızın desteğiyle aşağıdaki kod ile bazı sayfalardan A sütununda filtreleme yaparak mail gönderimi yapıyordum. Kodda ufak tefek bazı düzeltmeler yapmıştım ve gayet sağlıklı çalışıyordu. Ama bugünden itibaren "mail için" sayfasına kopyaladığı alanları iki kere kopyaladığını farkettim, bunun sebebi ne olabilir ?
Örnek dosya ektedir, mail at butonuna tıklayarak sonucu gözlemleyebilirsiniz.
Emir Hüseyin Çoban hocamızın desteğiyle aşağıdaki kod ile bazı sayfalardan A sütununda filtreleme yaparak mail gönderimi yapıyordum. Kodda ufak tefek bazı düzeltmeler yapmıştım ve gayet sağlıklı çalışıyordu. Ama bugünden itibaren "mail için" sayfasına kopyaladığı alanları iki kere kopyaladığını farkettim, bunun sebebi ne olabilir ?
Örnek dosya ektedir, mail at butonuna tıklayarak sonucu gözlemleyebilirsiniz.
Kod:
Sub kod()
Dim S1 As Worksheet: Set S1 = Sheets("mail için")
Dim OutApp As Object
Dim OutMail As Object
sayfalar = Array("", "Araç")
Dim i As Byte
Dim sonsat As Integer
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
S1.Visible = True: S1.Select
S1.Cells.Clear
S1.Range("B1") = "Aşağıda detayları verilen araçların alınmasını rica ederim."
S1.Range("B2") = " "
For i = 1 To 3
With Sheets(sayfalar(i))
On Error Resume Next
If Not .AutoFilterMode Then
.Range("A1").AutoFilter
Else
.ShowAllData
End If
.Range("A1").AutoFilter Field:=1, Criteria1:="Bankada"
.AutoFilter.Range.Copy
sonsat = S1.Cells(Rows.Count, "B").End(3).Row + 1
S1.Cells(sonsat, "A").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
S1.Paste
Application.CutCopyMode = False
If sonsat <> 3 Then
S1.Rows(sonsat).Delete Shift:=xlUp
End If
End With
Next i
For i = 1 To 3
With Sheets(sayfalar(i))
If Not .AutoFilterMode Then
.Range("A1").AutoFilter
Else
.ShowAllData
End If
End With
Next i
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
sonsat = S1.Cells(Rows.Count, "B").End(3).Row + 1
S1.Range("B1:I" & sonsat + 3).Copy
With OutMail
.To = "xx@xx.com.tr"
.Subject = "Araç Alımları Hk."
.Display
DoEvents
SendKeys "^v", True
End With
S1.Visible = False
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Application.SendKeys ("{NUMLOCK}")
End Sub
Ekli dosyalar
-
99.4 KB Görüntüleme: 11
Son düzenleme: