Werte in neue Datei kopieren

Private Sub CommandButton1_Click()
Dim Datei As File
Dim Erg As Range
Dim wsPL As Worksheet
Const cNrAdr = "A2"
With Workbooks("ISF.xlsm").Worksheets("fällig")
Set Erg = .Range("A2:A" & .Range("A99999").End(xlUp).Row).Find(wsPL.Range("A2").Value)
If Erg Is Nothing Then Set Erg = .Range("A99999").End(xlUp).Offset(1, 0) 'wenn kein Treffer, dann als neue Zeile am Ende
wsPL.Range("A2:M2").Copy
Erg.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub

Private Sub CommandButton1_Click()
Dim Datei As File
Dim Erg As Range
Dim wsPL As Worksheet
Const cNrAdr = "A2" 'Adresse der Zelle, wo der Planungsnummer zu lesen ist
Hier noch der Ursprüngliche Code aus meiner anderen Datei. Da funktioniert alles, sind aber noch Funktionen dabei, die ich bei dieser Mappe nicht brauche:
'unter Anbindung von Bibliothek "Microsoft Scripting Runtime":
'Extras, Verweise..., Hacken bei "Microsoft Scripting Runtime"
Dim FSO As New FileSystemObject
Dim DateiPfad As String
Const sPfadErledigt As String = "Dateipfad\"
Const DateinamenMuster = " K xxx.xlsm"

Private Sub CommandButton1_Click()
Dim Datei As File
Dim Erg As Range
Dim wsPL As Worksheet
Const cNrAdr = "AN31" 'Adresse der Zelle, wo der Planungsnummer zu lesen ist
'1. Prüfen, dass der Pfad gültig ist
'2. Prüfen, ob Dateinummer gültig ist
'3. Prüfen ob Datei bereit existiert
'4. + 5. Vorhandensein prüfen und an der richtige Stelle kopieren
'6. Datein Speichern
'1.
If Pfad_prüfen(sPfadErledigt) Is Nothing Then
MsgBox "Verzeichnis """ & sPfadErledigt & """ nicht vorhanden oder nicht gefunden.", vbExclamation
Exit Sub
End If
'2.
Set wsPL = ThisWorkbook.Worksheets("Planung")
If Not IsNumeric(wsPL.Range(cNrAdr).Value) Then
MsgBox "Nummer """ & wsPL.Range(cNrAdr).Value & """ ist für diese Datei nicht gültig.", vbExclamation
Exit Sub
End If
'3
DateiPfad = sPfadErledigt & Replace(DateinamenMuster, "xxx", wsPL.Range(cNrAdr).Value)
Set Datei = Datei_prüfen(DateiPfad)
If Not Datei Is Nothing Then
If MsgBox("Datei """ & Datei.ShortPath & """ existiert bereits. " & vbCr & vbCr & "Überschreiben?", vbYesNo + vbQuestion)  vbYes Then
Exit Sub
End If
End If
'4. + 5.
With Workbooks("Übersicht.xlsm").Worksheets("Übersicht")
Set Erg = .Range("A32:A" & .Range("A99999").End(xlUp).Row).Find(wsPL.Range("FR32").Value)
If Erg Is Nothing Then Set Erg = .Range("A99999").End(xlUp).Offset(1, 0) 'wenn kein Treffer, dann als neue Zeile am Ende
wsPL.Range("FR32:LA32").Copy
Erg.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With Workbooks("Übersicht.xlsm").Worksheets("Aufträge")
For Each Quelle In wsPL.Range("FR35:FR59").Cells
If Quelle.Value  "" Then
Set Erg = .Range("A2:A" & .Range("A99999").End(xlUp).Row).Find(Quelle.Value)
If Erg Is Nothing Then
Set Erg = .Range("A99999").End(xlUp).Offset(1, 0) 'neue Zeile unten
Else
Set Erg = Erg.EntireRow.Range("P1") 'die Spalte P innerhalb der Zeile des gefundenen Ergebnisses
If Erg.Value  "" Then Set Erg = Erg.EntireRow.Range("AE1") 'die Spalte AE innerhalb der Zeile des gefundenen Ergebnisses
If Erg.Value  "" Then Set Erg = Erg.EntireRow.Range("AT1")
If Erg.Value  "" Then Set Erg = Erg.EntireRow.Range("BI1")
End If
Quelle.Resize(1, 14).Copy
Erg.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
End With
'6.
ThisWorkbook.SaveAs DateiPfad, xlOpenXMLWorkbookMacroEnabled
'    ThisWorkbook.Close
End Sub




Private Sub SuchenErsetzen(Quelle As Range)
Dim Erg As Range
Set Erg = Range(Quelle.EntireColumn.Range("A32"), Quelle.Offset(-1, 0)).Find(Quelle.Value)
If Not Erg Is Nothing Then
Quelle.EntireRow.Copy Erg.EntireRow
Quelle.EntireRow.Delete
End If
End Sub



Function Pfad_prüfen(Pfad As String) As Folder

'gibt einen Folder-Objekt zurück, wenn Pfad vorhanden, sonst Nothing

On Error Resume Next

Set Pfad_prüfen = FSO.GetFolder(Pfad)

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AN31")) Is Nothing And Not Range("AN31") = "" Then _
Workbooks.Open "X:\Dateipfad"
End Sub