zwei unterschiedlichen Bereichen kopieren, in einer Tabelle einfügen

[Tom2020]

Hallo Zusammen,
 
vielleicht kann jemand bzgl. VBA-Codes helfen, danke im Voraus.
 
Es geht darum, dass ich von meiner Tabelle zwei unterschiedlichen Bereichen kopieren und in einer neuen Excel Datei, einfügen, speichern und schließen möchte.

Rng1 = ist ein fixer Bereich, eingefügt ab Zeile 1
Rng2 = wird via inputbox ausgewählt, eingefügt ab Zeile 3

leider kommt es zu Error 91

Irgendwelche Idee?

t

-----------------
Sub CPS()
Dim Rng1 As Range
Dim Rng2 As Range
On Error Resume Next
dt = Format(CStr(Now), "yyyy.mm.dd_hhmmss")


Set rag1 = Range("A1:L2").Select
rag1.Copy

Set Rng2 = Application.InputBox(Title:="Please select a range", Prompt:="Select range", Type:=8)
On Error GoTo 0
If Rng2 Is Nothing Then Exit Sub
Rng2.Copy


Set newbook = Workbooks.Add
newbook.Activate
Sheets.Add.Name = "Error"
ActiveSheet.Range("A1").Select
Rng1.PasteSpecial
ActiveSheet.Range("A3").Select
Rng2.PasteSpecial

ActiveSheet.Range("A1").Select

Application.DisplayAlerts = False
Worksheets("Tabelle1").Delete
Application.DisplayAlerts = True

newbook.SaveAs Filename:="C:\TEMP\Error_" & dt & ".xlsx"
newbook.Close
End Sub

[UweD]

Hallo

als TIPP

- aktiviere im VB Editor unter Extras, Optionen Variablendeklaration erforderlich, OK
- Dadurch wird in neuen Modulen etc in der obersten Zeile "Option Explicit" angezeigt
- Das kannst du natürlich auch händisch dahin schreiben

Stände das da, wäre dir aufgefallen, das du anstelle Rng1 Rag1 geschrieben hast.

War es das schon?


LG UweD

[Tom2020]

jo anke .... so sieht es aus:

Code:

Option Explicit

Sub CPS()
Dim Rng1 As Range
Dim Rng2 As Range
Dim dt As String
Dim newbook As Workbook

On Error Resume Next
dt = Format(CStr(Now), "yyyy.mm.dd_hhmmss")

Set Rng1 = Range("A1:L2").Select
Rng1.Copy

Set Rng2 = Application.InputBox(Title:="Please select a range", Prompt:="Select range", Type:=8)
On Error GoTo 0
If Rng2 Is Nothing Then Exit Sub
Rng2.Copy


Set newbook = Workbooks.Add
newbook.Activate
Sheets.Add.Name = "Error"
ActiveSheet.Range("A1").Select

Set Rng1 = Range("A1:L2").Select
Rng1.Copy
[u]Rng1.PasteSpecial[/u]


ActiveSheet.Range("A3").Select
Rng2.PasteSpecial

ActiveSheet.Range("A1").Select

Application.DisplayAlerts = False
Worksheets("Tabelle1").Delete
Application.DisplayAlerts = True

newbook.SaveAs Filename:="C:\TEMP\Error_" & dt & ".xlsx"
newbook.Close
End Sub

erhalte error 424, Objekt erforderlich ????

[UweD]

Hallo nochmal

versuch es so.

Code:

Option Explicit

Sub CPS()
    Dim Rng1 As Range, Rng2 As Range
    Dim dt As String
    Dim newbook As Workbook, TNB As Worksheet
   
    On Error Resume Next
    dt = Format(CStr(Now), "yyyy.mm.dd_hhmmss")
   
    Set Rng1 = Range("A1:L2")
   
    Set Rng2 = Application.InputBox(Title:="Please select a range", Prompt:="Select range", Type:=8)
    On Error GoTo 0
    If Rng2 Is Nothing Then Exit Sub
   
    Set newbook = Workbooks.Add
    Set TNB = newbook.Sheets(1)
    TNB.Name = "Error"
   
    Rng1.Copy TNB.Range("A1")
    Rng2.Copy TNB.Range("A3")
   
    newbook.SaveAs Filename:="C:\TEMP\Error_" & dt & ".xlsx"
    newbook.Close
End Sub

LG UweD

[Tom2020]

besten Dank UweD für die schnelle Hilfe