Kopieren in freie Zelle

Hallo zusammen,
ich habe da ein Problem und komme nicht weiter.
Ich habe zwei dateien. Qelle.xlsm und Ziel.xlsm. Ich möchte nun aus der "Qelle" die Zeile B4 bis D4 kopieren.
Diese möchte ich dann in "Ziel" in die nächste freie Zeile einfügen.
Ich möchte so dann mehrere Daten aus "Quelle" kopieren und die in "Ziel" einfügen. Dabei sollen die alten Daten jedoch nicht überschrieben werden.
Vielleicht kann mit ja jemand helfen.
Ich habe bereits Versucht mir einen Code anzupassen jedoch klappt das nicht -.-

Sub KopierenN()
Dim Wkb_Q  As Workbooks
Dim Wkb_Z  As Workbooks
Set Wkb_Q = Workbooks.Open("Z:\Quelle.xlsm")
Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2")
Wkb_Q.Range("B4:D4").Copy
Wkb_Z.Range("A" & Wkb_Z.Cells(Wkb_Z.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Grüße Jens

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub KopierenN() Dim Wkb_Q As Workbooks, sTabelleQ$, rngQ As Range Dim Wkb_Z As Worksheet Set Wkb_Q = Workbooks.Open("Z:\Quelle.xlsm") sTabelleQ = "Tabelle1" 'Tabelle in Quelle Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2") With Wkb_Z 'Range aus Quelle Set rngQ = Wkb_Q.Sheets(sTabelleQ).Range("B4:D4") 'in nächste leere in Spalte A einfügen .Cells(1, .Rows.Count, 1).End(xlUp).Offset(1, 0) _ .Resize(rngQ.Rows.Count, rngQ.Columns.Count).Value = rngQ.Value End With End Sub

Hallo Tino,
danke für die Antwort aber leider bekomme ich eine Fehlermeldung: Fehler beim Kompilieren - Methode oder Datenobjekt nicht gefunden.
Markiert wird folgender Absatz: et rngQ = Wkb_Q.Sheets
Blau hinterlegt ist dabei ".Sheets"
Sub KopierenN()
Dim Wkb_Q As Workbooks, sTabelleQ$, rngQ As Range
Dim Wkb_Z As Worksheet
Set Wkb_Q = Workbooks.Open("Z:\Quelle.xlsm")
sTabelleQ = "Tabelle1" 'Tabelle in Quelle
Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2")
With Wkb_Z
'Range aus Quelle
Set rngQ = Wkb_Q.Sheets(sTabelleQ).Range("B4:D4")
'in nächste leere in Spalte A einfügen
.Cells(1, .Rows.Count, 1).End(xlUp).Offset(1, 0) _
.Resize(rngQ.Rows.Count, rngQ.Columns.Count).Value = rngQ.Value
End With
Grüße Jens

Sub Kopieren1() Dim Wkb_Q As Workbook, sTabelleQ$, rngQ As Range Dim Wkb_Z As Worksheet Set Wkb_Q = Workbooks.Open("Z:\Testumgebung\Hauptmontage\" & Range("D5") & ".xlsm") sTabelleQ = "Tabelle1" 'Tabelle in Quelle Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2") With Wkb_Z 'Range aus Quelle Set rngQ = Wkb_Q.Sheets(sTabelleQ).Range("B4:D4") 'in nächste leere in Spalte A einfügen .Cells(1, .Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rngQ.Rows.Count, rngQ.Columns.Count) _ .Value = rngQ.Value End With End Sub

Sub Kopieren1() Dim Wkb_Q As Workbook, sTabelleQ$, rngQ As Range Dim Wkb_Z As Worksheet Set Wkb_Q = Workbooks.Open("Z:\Testumgebung\Hauptmontage\" & Range("D5") & ".xlsm") sTabelleQ = "Tabelle1" 'Tabelle in Quelle Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2") With Wkb_Z 'Range aus Quelle Set rngQ = Wkb_Q.Sheets(sTabelleQ).Range("B4:D4") 'in nächste leere in Spalte A einfügen .Cells(1, .Rows.Count).End(xlUp).Offset(1, 0).Resize(rngQ.Rows.Count, rngQ.Columns.Count). _ Value = rngQ.Value End With End Sub

Sub Kopieren1() Dim Wkb_Q As Workbook, sTabelleQ$, rngQ As Range Dim Wkb_Z As Worksheet Set Wkb_Q = Workbooks.Open("Z:\Testumgebung\Hauptmontage\" & Range("D5") & ".xlsm") sTabelleQ = "Tabelle1" 'Tabelle in Quelle Set Wkb_Z = ThisWorkbook.Worksheets("Tabelle2") With Wkb_Z 'Range aus Quelle Set rngQ = Wkb_Q.Sheets(sTabelleQ).Range("B4:D4") 'in nächste leere in Spalte A einfügen .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) _ .Resize(rngQ.Rows.Count, rngQ.Columns.Count).Value = rngQ.Value End With End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread