Bereich kopieren und variabel einfügen

Forumthread: Bereich kopieren und variabel einfügen

02.04.2019 14:31:05

Anton

Hallo liebe Community,
ich habe eine Frage zur Umsetzung bei VBA.
Ich möchte gerne in die ersten beiden Spalten (A & B) die anderen Spalten mit Hilfe von VBA untereinander einfügen.
Dafür müsste ich in VBA variabel die Bereiche bestimmen (immer die 2 nächsten Spalten), kopieren und den freien Raum (freie Zeilen) in den ersten beiden Spalten bestimmen, um sie dann dorthin einzufügen.
Hier die Datei. Bei Start befindet sich der Anfangszustand und bei Ziel so wie es am Ende aussehen soll.
https://www.herber.de/bbs/user/128845.xlsm
Danke im Voraus
Und viele Grüße
Anton

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bereich kopieren und variabel einfügen

02.04.2019 15:01:35

Daniel
AW: Bereich kopieren und variabel einfügen

02.04.2019 15:10:28

UweD

AW: Bereich kopieren und variabel einfügen

02.04.2019 15:01:35

Daniel

Hallo Anton,
mit VBA wie gewünscht:

Sub Untereinander()
Dim arr() As Variant
Dim AnzSpalten As Long, AnzZeilen As Long, i As Long, j As Long, freieZeile As Long, z As Long
AnzSpalten = Cells.SpecialCells(xlCellTypeLastCell).Column
freieZeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
z = 1
For i = 3 To AnzSpalten Step 2
AnzZeilen = Cells(Rows.Count, i).End(xlUp).Row
For j = 1 To AnzZeilen
ReDim Preserve arr(z)
arr(z) = Cells(j, i).Resize(1, 2)
z = z + 1
Next j
Next i
For i = 1 To UBound(arr)
Range(Cells(freieZeile, 1), Cells(freieZeile, 2)) = arr(i)
freieZeile = freieZeile + 1
Next i
End Sub

Büschen Umständlich aber klappt ganz gut und sollte schnell sein. Das Ganze geht aber bestimmt viel eleganter mit PQ, mal sehen ob jemand mit einer Lösung kommt.
Gruß
Daniel

AW: Bereich kopieren und variabel einfügen

02.04.2019 15:10:28

UweD

Hallo
auch noch was von mir

Sub Kopieren()
    Dim i As Integer, LR1 As Long, LRi As Long
    Dim LC As Integer
    
    
    LC = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 
    
    For i = 3 To LC - 1 Step 2
        LR1 = Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile der Spalte 
        LRi = Cells(Rows.Count, i).End(xlUp).Row
        Cells(1, i).Resize(LRi, 2).Copy Cells(LR1, 1).Resize(LRi, 2)
    Next
    Columns(3).Resize(, LC - 2).ClearContents
End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

Bereich kopieren und variabel einfügen

Forumthread: Bereich kopieren und variabel einfügen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread