Makro Excel nach Auftragsnummer zusammenkopieren

Sub kopieren()
Dim wkb As Workbook, wks As Worksheet
Const sPfad As String = "c:\desktop\"
Const sFile As String = "Datei2.xls"
Const sSheet As String = "DLZ Bereichsstellungnahmen"
Set wks = ActiveSheet
Set wkb = Workbooks.Open(sPfad & sFile)
With wks
.Cells(7, 40) = "Erste Beauftr. E-Bereich"
.Cells(7, 41) = "Freigabe E-Bereich"
.Cells(7, 42) = "DLZ E Beauftr. - Freigabe"
.Cells(7, 43) = "DLZ E Beauftr. - akt. Datum"
.Cells(7, 44) = "Erste Beauftr. P-Bereich"
.Cells(7, 45) = "Freigabe P-Bereich"
.Cells(7, 46) = "DLZ P Beauftr. - Freigabe"
.Cells(7, 47) = "DLZ P Beauftr. - akt. Datum"
.Cells(7, 48) = "Erste Beauftr. K-Bereich"
.Cells(7, 49) = "Freigabe K-Bereich"
.Cells(7, 50) = "DLZ K Beauftr. - Freigabe"
.Cells(7, 51) = "DLZ K Beauftr. - akt. Datum"
.Cells(7, 52) = "Erste Beauftr. M-Bereich"
.Cells(7, 53) = "Freigabe M-Bereich"
.Cells(7, 54) = "DLZ M Beauftr. - Freigabe"
.Cells(7, 55) = "DLZ M Beauftr. - akt. Datum"
.Cells(7, 56) = "Erste Beauftr. Q-Bereich"
.Cells(7, 57) = "Freigabe Q-Bereich"
.Cells(7, 58) = "DLZ Q Beauftr. - Freigabe"
.Cells(7, 59) = "DLZ Q Beauftr. - akt. Datum"
.Cells(7, 60) = "Erste Beauftr. V-Bereich"
.Cells(7, 61) = "Freigabe V-Bereich"
.Cells(7, 62) = "DLZ V Beauftr. - Freigabe"
.Cells(7, 63) = "DLZ V Beauftr. - akt. Datum"
.Cells(7, 64) = "Erste Beauftr. MT-Bereich"""
.Cells(7, 65) = "Freigabe MT-Bereich"
.Cells(7, 66) = "DLZ MT Beauftr. - Freigabe"
.Cells(7, 67) = "DLZ MT Beauftr. - akt. Datum"
.Cells(7, 68) = "Erste Beauftr. EM-Bereich"
.Cells(7, 69) = "Freigabe EM-Bereich"
.Cells(7, 70) = "DLZ EM Beauftr. - Freigabe"
.Cells(7, 71) = "DLZ EM Beauftr. - akt. Datum"
With .Range(.Cells(8, 1), .Cells(Rows.Count, 1).End(xlUp)).Offset(, 39).Resize(, 72)
.FormulaR1C1 = _
"=iferror(vlookup(rc1,'[" & sFile & "]" & sSheet & "'!c1:c38,column(r1c[-33]), 0),"""")" _
_
_
_
End With
With .Range("AN:BS")
.Copy
.PasteSpecial xlPasteValues
End With
End With
wkb.Close False
Application.CutCopyMode = False
End Sub