Kopierfunktion:

Forumthread: Kopierfunktion:

Kopierfunktion:

12.04.2016 13:34:52

Mirko

Ich als Anfänger habe folgende Frage:
Suche eine Makro für folgende Problemstellung:
Habe Tabelle 1, von welcher ich Werte in die Tabelle 2 Kopieren will.
Die Werte in der Tabelle 1 sind verstreut: B8, C9, B13 etc diese sollen jeweils in die Tabelle 2 in einer Zeile kopiert werden. Habe diverses ausprobiert, jedoch klappte dies nur bedingt.
Vieleicht kann mir jemand eine starthilfe geben
Danke im voraus.

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Kopierfunktion:

12.04.2016 14:07:38

UweD
AW: Kopierfunktion:

13.04.2016 16:24:47

Mirko
AW: Kopierfunktion:

14.04.2016 09:29:45

UweD
AW: Kopierfunktion:

15.04.2016 22:13:33

Mirko
AW: Warum dann noch offen?

16.04.2016 14:58:17

Werner
AW: Warum dann noch offen?

16.04.2016 15:21:30

Mirko

AW: Kopierfunktion:

12.04.2016 14:07:38

UweD

Starthilfe...
Die "zerstreuten Zellen" kannst du in dem Array eintragen


Sub kopieren()
Dim Tb1, Tb2, i As Integer
Dim Zeile As Integer, Spalte As Integer
Dim Arr
Set Tb1 = Sheets("Tabelle1")
Set Tb2 = Sheets("Tabelle2")
Arr = Array("B8", "C9", "B19") ' anpassen
Zeile = 1 ' Zielzeite
Spalte = 1 ' erste Zielspalte
For i = 0 To UBound(Arr)
Tb2.Cells(Zeile, Spalte + i) = Tb1.Range(Arr(i)).Value
Next
End Sub

Gruß UweD

AW: Kopierfunktion:

13.04.2016 16:24:47

Mirko

Besten Dank super Antwort,
Wie könnte man dies meistern, wenn die Tabelle an einem anderen Pfad wäre?
Besten Dank

AW: Kopierfunktion:

14.04.2016 09:29:45

UweD

Hallo nochmal
so?

Sub kopieren()
Dim TB1 As Worksheet, WB2 As Workbook, TB2 As Worksheet
Dim Zeile As Integer, Spalte As Integer
Dim Arr, i As Integer
Dim Pfad As String, Datei As String
'anpassen **
Pfad = "C:\Temp\"
Datei = "Mappe2.xlsx"
Set TB1 = ActiveWorkbook.Sheets("Tabelle1")
Set WB2 = Workbooks.Open(Pfad & Datei)
Set TB2 = WB2.Sheets("Tabelle2")
Arr = Array("B8", "C9", "B19")
'anpassen **
Zeile = 1 ' Zielzeile
Spalte = 1 ' erste Zielspalte
For i = 0 To UBound(Arr)
TB2.Cells(Zeile, Spalte + i) = TB1.Range(Arr(i)).Value
Next
WB2.Close True 'inkl. speichern
End Sub

AW: Kopierfunktion:

15.04.2016 22:13:33

Mirko

Perfekt, Besten Dank!!!

AW: Warum dann noch offen?

16.04.2016 14:58:17

Werner

Hallo Mirko,
wenn das Problem gelöst ist, dann solltest du den Beitrag nicht auf offen stellen.
Gruß Werner

AW: Warum dann noch offen?

16.04.2016 15:21:30

Mirko

Sorry

Beliebteste Forumthreads (12 Monate)

Forumthread: Kopierfunktion:

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread