Spalten bzw. Bereiche untereinander kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Uwe,
zu einer guten Fragestellung gehört meist auch die Darstellung der eigenen Versuche, das Problem zu lösen.
Warum hast du nicht alle Teile, die sich leicht z. B. mittels Makroaufzeichnung erstellen lassen, hier mitgeteilt?
Das Öffnen und Schließen der Quellmappe kann wohl wirklich kein Problem sein...
Zum einen hätte man daran sofort gesehen, dass du eine VBA-LÖsung suchst. Zum anderen stünden im Code
die Namen von Mappen und Blättern, so dass sich der Antworter nicht erst etwas ausdenken muss.
Probier mal (wobei hier überhaupt nicht kopiert wird): Option Explicit Sub SpaltenUntereinander() Dim arQ, arZ(), zz As Long, cc As Long Workbooks.Open "c:\tmp\eine Exceldatei.xlsx", ReadOnly:=True ' Quellmappe arQ = Sheets("auf einem bestimmten Sheet").Range("D13:H28").Value ' Quellbereich ActiveWorkbook.Close False ReDim arZ(1 To UBound(arQ) * UBound(arQ, 2), 0) ' Zielarray For zz = 1 To UBound(arQ) For cc = 1 To UBound(arQ, 2) arZ(UBound(arQ) * (cc - 1) + zz, 0) = arQ(zz, cc) ' Zielarray füllen Next cc Next zz ' Ausgabe ThisWorkbook.Sheets("Zieltabelle").Cells(2, 9).Resize(UBound(arZ)) = arZ End Sub Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Hallo
hier eine doppelte Makro Lösung. Je nachdem ob man alles kopieren will,
Bereich D13:D28 usw. mit Formate und Rahmen, oder nur die Zell Inhalte.
Die Ziel Adresse steht in Const und kann beliebig geaendert werden.
Ich habe "L2" genommen falls in "L1" eine Überschrift stehen soll.
Bei Zeile Range(xxx) habe ich Rows.Count + 1 gewaehlt für 1 Leerzeile.
Ohne +1 wird alles untereinander kopiert. Ich bevorzuge 1-2 Leerzeilen.
Const ZAdr = "L2" 'Zelle L1 freigelassen für Überschrift

Sub Bereiche_inSpalte_kopieren()
Dim QTab As Object, ZTab As Object, Zeile As Integer
Set QTab = Sheets("Tabelle1")
Set ZTab = Sheets("Tabelle2")
'Zeile als Offset für weiteres kopieren
Zeile = QTab.Range("D13:D28").Rows.Count + 1
'Kopiere Bereich D13:D28 - H13:H28 -mit Formate- in Ziel Tabelle
QTab.Range("D13:D28").Copy ZTab.Range(ZAdr)
QTab.Range("E13:E28").Copy ZTab.Range(ZAdr).Offset(Zeile, 0)
QTab.Range("H13:H28").Copy ZTab.Range(ZAdr).Offset(Zeile * 2, 0)
Application.CutCopyMode = False
End Sub

Sub Nur_Werte_inSpalte_kopieren()
Dim QTab As Object, ZTab As Object, Zeile As Integer
Set QTab = Sheets("Tabelle1")
Set ZTab = Sheets("Tabelle2")
'Zeile als Offset für weiteres kopieren
Zeile = QTab.Range("D13:D28").Rows.Count + 1
'Kopiere -nur Werte- von D13:D28 - H13:H28 in Ziel Tabelle
QTab.Range("D13:D28").Copy
ZTab.Range(ZAdr).PasteSpecial xlValues
QTab.Range("E13:E28").Copy
ZTab.Range(ZAdr).Offset(Zeile, 0).PasteSpecial xlValues
QTab.Range("H13:H28").Copy
ZTab.Range(ZAdr).Offset(Zeile * 2, 0).PasteSpecial xlValues
Application.CutCopyMode = False
End Sub

Gruss Adis

Beliebteste Forumthreads (12 Monate)

	I
2	13x4
3	14x4
4	15x4
5	16x4
6	17x4
7	18x4
8	19x4
9	20x4
10	21x4
11	22x4
12	23x4
13	24x4
14	25x4
15	26x4
16	27x4
17	28x4
18	13x5
19	14x5
20	15x5
21	16x5
22	17x5

Spalten bzw. Bereiche untereinander kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten bzw. Bereiche untereinander kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread