bu arada kodlar da kopyalanıyor sayfayla beraber yeni kitap-->yeni sayfa-->sadece 3-4 satırı kopyala yapsak daha hızlı ve kolay olmaz mı? diğerlerinin arka planda çalışan kodlara ihtiyacı var mı? 
not: önerim sadece teorik nasıl yapılır bilmiyorum )

dilerim işinize yarar

Sub MailActiveSheet()



Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim i As Integer



i = ActiveCell.Row '<=========== Eklenen Satır i ile aktif satır belirlenip ona göre kopyalama yapılır

With Application

    .ScreenUpdating = False

    .EnableEvents = False

End With



Set Sourcewb = ThisWorkbook



ActiveSheet.Copy

Set Destwb = ActiveWorkbook



With Destwb

    FileExtStr = ".xlsb": FileFormatNum = 50

End With



TempFilePath = Environ$("temp") & "\"

TempFileName = " " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")



'================>Eklenen<==========================================

Range(i & ":" & i).Copy Destwb.Worksheets("W.O KAYIT").Range("4:4")   '<=========== Eklenen Satır sadece seçtiğiniz satırı kopyalar

Destwb.Worksheets("W.O KAYIT").Range("A5:Z993").Clear                 '<=========== Eklenen Satır Geriye kalanı siler

'================>Eklenen BİTTİ<==========================================



Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)



With Destwb

    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

    On Error Resume Next

    With OutMail

        .to = ""

        .CC = ""

        .BCC = ""

        .Subject = "C&I BAKIM WORK ORDER"

        .Body = "Sayın İlgililer" & vbNewLine & vbNewLine & "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz." & vbNewLine & vbNewLine & "İyi Çalışmalar"

        .Attachments.Add Destwb.FullName

        '.Send

        .Display

    End With

    On Error GoTo 0

    .Close savechanges:=False

End With



Kill TempFilePath & TempFileName & FileExtStr



Set OutMail = Nothing

Set OutApp = Nothing



With Application

    .ScreenUpdating = True

    .EnableEvents = True

End With

End Sub

(10/05/2019, 04:21)haliliyas yazdı: bu arada kodlar da kopyalanıyor sayfayla beraber yeni kitap-->yeni sayfa-->sadece 3-4 satırı kopyala yapsak daha hızlı ve kolay olmaz mı? diğerlerinin arka planda çalışan kodlara ihtiyacı var mı? 
not: önerim sadece teorik nasıl yapılır bilmiyorum )

dilerim işinize yarar

Sub MailActiveSheet()



Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim i As Integer



i = ActiveCell.Row '<=========== Eklenen Satır i ile aktif satır belirlenip ona göre kopyalama yapılır

With Application

    .ScreenUpdating = False

    .EnableEvents = False

End With



Set Sourcewb = ThisWorkbook



ActiveSheet.Copy

Set Destwb = ActiveWorkbook



With Destwb

    FileExtStr = ".xlsb": FileFormatNum = 50

End With



TempFilePath = Environ$("temp") & "\"

TempFileName = " " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")



'================>Eklenen<==========================================

Range(i & ":" & i).Copy Destwb.Worksheets("W.O KAYIT").Range("4:4")   '<=========== Eklenen Satır sadece seçtiğiniz satırı kopyalar

Destwb.Worksheets("W.O KAYIT").Range("A5:Z993").Clear                 '<=========== Eklenen Satır Geriye kalanı siler

'================>Eklenen BİTTİ<==========================================



Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)



With Destwb

    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

    On Error Resume Next

    With OutMail

        .to = ""

        .CC = ""

        .BCC = ""

        .Subject = "C&I BAKIM WORK ORDER"

        .Body = "Sayın İlgililer" & vbNewLine & vbNewLine & "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz." & vbNewLine & vbNewLine & "İyi Çalışmalar"

        .Attachments.Add Destwb.FullName

        '.Send

        .Display

    End With

    On Error GoTo 0

    .Close savechanges:=False

End With



Kill TempFilePath & TempFileName & FileExtStr



Set OutMail = Nothing

Set OutApp = Nothing



With Application

    .ScreenUpdating = True

    .EnableEvents = True

End With

End Sub

Hocam emeğinize sağlık , çok güzel hazırlamışsınız,uğraşmışsınız. Fakat mailde ek olmasına gerek yok. Yapmak istediğim Sadece örnek: A4 ile L4 arasınındaki iş emrini mail body'sine yazmasıdır. Örneği eklşyorum.

Saygılarımla

[img][/img]

resim geldi mi acaba. Yükleyemedim sanırım resmi.

dilerim işinize yarar)

(10/05/2019, 16:54)ertus35 yazdı: resim geldi mi acaba. Yükleyemedim sanırım resmi.

(10/05/2019, 18:22)haliliyas yazdı: dilerim işinize yarar)

Halil Bey,

Tabiki işime çok yarıyor. Çok sağ olun. Önce Sizin oluşturduğunuzu atacağım. Sonra benim son olarak sizden ricamı atacağım. 

Tüm satırı aldığında tablo çevreleri ve gizli sütunlardan dolayı mail yana doğru çok uzuyor  . Biz Sadece K ve L sütunlarını alabilir miyiz ve bu yazı "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz. İyi Çalışmalar" yazısının altına gelbilir mi.

Saygılarımla[img][/img]