Nicht angrenzende Zellen kopieren - VBA

Guten Tag zusammen,
Ein Abschnitt meines Makros beinhaltet das Kopieren von gewissen Zellen in eine andere Mappe.
Notdürftig habe ich das Problem mit dem "Excel will nicht nicht angrenzende Zellen kopieren" wie folgt gelöst:
Workbooks.Open "PFAD"
Workbooks("MAPPE".xlsx").Worksheets("Tabelle").Rows("3:3").Insert Shift:=xlUp
Range("B1,C1").Copy
Worksheets("Tabelle").Range("A3").PasteSpecial Paste:=xlValues
Range("A2").Copy
Worksheets("Tabelle").Range("C3").PasteSpecial Paste:=xlValues
Range("F2").Copy
Worksheets("Tabelle").Range("D3").PasteSpecial Paste:=xlValues
Range("B2").Copy
Worksheets("Tabelle").Range("E3").PasteSpecial Paste:=xlValues
Range("C2").Copy
Worksheets("Tabelle").Range("F3").PasteSpecial Paste:=xlValues
Workbooks("MAPPE.xlsx").Close SaveChanges:=True

Das ist sicher eine ziemlich schlechte Lösung, kann mir jemand sagen wie ich das besser lösen kann?
Danke!
MfG,
Q94

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Q94,
da du nur die Werte aus der Quelltabelle in die Zieltabelle eintragen willst geht es auch ohne Copy-Methode. Man kann die Werte auch direkt im Ziel eintragen.
Gruß
Franz

Sub Test()
Dim wkbZiel As Workbook
Workbooks.Open "PFAD"
Set wkbZiel = Application.Workbooks("MAPPE.xlsx")
With wkbZiel.Worksheets("Tabelle")
.Rows("3:3").Insert Shift:=xlUp
.Range("A3").Value = Range("B1").Value
.Range("B3").Value = Range("C1").Value
.Range("C3").Value = Range("A2").Value
.Range("D3").Value = Range("F2").Value
.Range("E3").Value = Range("B2").Value
.Range("F3").Value = Range("C2").Value
End With
wkbZiel.Close SaveChanges:=True
End Sub
Sub Test_Variante()
Dim wkbZiel As Workbook
Dim i As Integer, arrQ, arrZ
'Zellen in Quelltabelle, deren Werte übertragen werden sollen
arrQ = Array("B1", "C1", "A2", "F2", "B2", "C2")
'zugehörige Zellen in Zieltabelle in die Werte eingetragen werden sollen
arrZ = Array("A3", "B3", "C3", "D3", "E3", "F3")
Workbooks.Open "PFAD"
Set wkbZiel = Application.Workbooks("MAPPE.xlsx")
With wkbZiel.Worksheets("Tabelle")
For i = LBound(arrQ) To UBound(arrQ)
.Range(arrZ(i)).Value = Range(arrQ(i)).Value
Next
End With
wkbZiel.Close SaveChanges:=True
End Sub

Beliebteste Forumthreads (12 Monate)

Nicht angrenzende Zellen kopieren - VBA

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nicht angrenzende Zellen kopieren - VBA

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread