Hallo, 

Ich habe einiges hier zusammengebaut.

1. Wie kann ich beim Kopieren der Daten definieren, dass es nur die Spalten 2 bis 12 und 14 bis 15 kopiert?

2. Beim Speichern der Datei wird es in den übergeordneten Ordner gespeichert. Wie speichere ich es im angegebenen Pfad?

Vielen Dank.

Sub searchandcopy()

Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim accountnum As String
Dim finalrow As Integer
Dim i As Integer
Dim edress As String
Dim subj As String
Dim message As String
Dim filename As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim path As String
Dim attachment As String


Set erange = Sheet4.Range("B4:C18")

Set datasheet = Sheet1
Set reportsheet = Sheet2
accountnum = reportsheet.Range("A1").Value
edress = Application.WorksheetFunction.VLookup(accountnum, erange, 2, False)

reportsheet.Range("B1").Value = edress

reportsheet.Range("A4:O1000").ClearContents

datasheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 5 To finalrow
    If Cells(i, 14) = accountnum Then
    Range(Cells(i, 2), Cells(i, 12)).Copy
    reportsheet.Select
    Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Columns("A:O").Select
    Selection.Columns.autofit
    datasheet.Select
    End If
    

    
Next i

reportsheet.Select
Set outlookapp = CreateObject("Outlook.Application")
    Set outlookmailitem = outlookapp.createitem(0)
    Set myAttachments = outlookmailitem.Attachments

path = "S:\Back Office\EOD Broker Trade Files Imagine\EOD REPORT"
    Application.DisplayAlerts = False
    
  filename = "_" & accountnum & "_" & Range("E1") & ".pdf"
    subj = accountnum
    
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
            path + filename, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
    
    attachment = path + filename
        
        outlookmailitem.To = edress
        outlookmailitem.cc = ""
        outlookmailitem.bcc = ""
        outlookmailitem.Subject = Range("E1")
        outlookmailitem.body = ""
           
            
        myAttachments.Add (attachment)
        outlookmailitem.display
        'outlookmailitem.send
        Application.DisplayAlerts = True
        
        Set outlookapp = Nothing
        Set outlookmailitem = Nothing
        
         



Range("A1").Select



End Sub