Hallo noch mal, brauche doch noch mal Hilfe.
Ich habe/hatte einen funktionierenden Code, um aus einer Datei einen Bereich in eine andere Datei zu kopieren und unter dem mitkopierten Namen zu speichern
Sub()
Dim strDateiname As String
' im aktiven Tabellenblatt die zu kopierenden Zellen definieren und kopieren
Sheets("Exportdaten").Range("a1:ga3000").Copy
' Zieldatei öffnen
Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\Exceltest\Master\VP Neu.xlsx"
' Ziel zum Einfügen definieren und als Werte einfügen
ActiveWorkbook.Sheets("Importdaten").Range("a1:ga3000").PasteSpecial Paste:=xlPasteValues
' Die Zelle(n) definieren, aus denen der neue Dateiname ausgelesen werden soll
strDateiname = Range("A1").Value & ".xlsx"
ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\Exceltest\Ergebnisse\" & strDateiname
Application.CutCopyMode = False
ActiveWorkbook.Close
End Sub
Wegen Einbau von Pivot-Tabellen in der Zeildatei kann der Dateiname nun nicht mehr in der ersten Zeile des kopierten Bereichs mitgeliefert werden. Nun habe ich gedacht, gleichzeitig kopieren geht sicher nicht, am einfachsten wäre es, den Dateinamen - nach dem einfügen des Datenpakets - wieder aus der Quelldatei an eine andere Stelle in der Zieldatei zu speichern, ungefähr so:
'zurück zur Quelldatei
Windows("Steuerungsdatei.xlsm").Activate
'Kopierbereich auswählen
Sheets("Tabelle1").Range("D3:E3").Copy
'Wieder zur Zieldatei
Windows("VP Neu.xlsx").Activate
'Den Bereich definieren, wo die kopierten Zellen eingefügt werden sollen.
Sheets("Deckblatt").Windows("VP Neu.xlsx").Activate
Sheets("Deckblatt").Range("B1:C1").PasteSpecial Paste:=xlPasteValues
Leider klappt das nicht :-( der Code hängt sich auf bei den Sheets am Ende. Kann mir bitte jemand den Codefehler beseitigen?
Grüße
Reinhard