Clever-Excel-Forum

Normale Version: zwei unterschiedlichen Bereichen kopieren, in einer Tabelle einfügen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
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
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
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 ????
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
besten Dank UweD für die schnelle Hilfe