Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereich kopieren und variabel einfügen

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
Anzeige
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
Anzeige
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
Anzeige

337 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige