VAB: Excel Bereich kopieren und in neue Mappe schreiben

[S1lverSurf3r]

Hallo Zusammen,

ich würde gerne einen ExcelBereich kopieren und in eine neue Arbeitsmappe schreiben. Leider scheitert es bei meinem derzeitigen Code daran, das der Inhalt nicht in die neue sondern in die bestehende Mappe kopiert wird.

Habt ihr eine Idee?

Vielen Dank für eure Hilfe

Michael

Sub Speichern()
Dim olAPP As Object
Dim olMail As Object
Set olAPP = CreateObject("Outlook.Application")
Set olMail = olAPP.CreateItem(0)

Workbooks.Add
With ThisWorkbook.Sheets("project").Range("A1:M2").Copy
With Range("A1")
        'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
           
            ActiveSheet.Name = "project"
          
            ActiveWorkbook.SaveAs "C:\Test1.xlsx"
        End With

 

[Brinox]

Wenn du Range schreibst, ist das gleichbedeutend mit ThisWorkbook.ActiveSheet.Range, daher:

Set newWorkbook = Workbooks.Add
Range("A1:M2").Copy
newWorkbook.ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

...

newWorkbook.ActiveSheet.Name = "project"
newWorkbook.SaveAs "C:\Test1.xlsx"

 

[S1lverSurf3r]

Perfekt.

Vielen Dank!