zitroooo
Goto Top

VBA Zeile einfügen - Zelle verschieben

Hallo alle zusammen,

Da ich mich nun zum erstenmal in Visual Basic ausprobiere, benötige ich Hilfe.

Ich habe folgende Excel Tabelle:
(Sheet1)

Spalte A Spalte B Spalte C Spalte D
1 2 3 4


und benötige:
(Sheet2)

Spalte A Spalte B
1 2
3 4

sprich, es soll immer eine Zeile eingefügt werden wenn Werte in den Spalten (A-Z) von Sheet1 stehen und soll nicht über 2 Spalten hinaus gehen.
Wenn eine Spalte leer ist soll keine neue Zeile Eingefügt werden und das Skript soll zur nächsten Spalten in Sheet1 springen.

Etwas kniffelig und schwierig zu erklären, aber ich hoffe ich finde hier Rat.

Content-Key: 2848739696

Url: https://administrator.de/contentid/2848739696

Ausgedruckt am: 28.03.2024 um 22:03 Uhr

Mitglied: colinardo
Lösung colinardo 20.05.2022 aktualisiert um 10:55:01 Uhr
Goto Top
Servus,
so wie ich das interpretiert habe solltest du hiermit klar kommen.

back-to-topAusgangslage in "Tabelle1":

screenshot

back-to-topErgebnis in "Tabelle2" nach Anwenden des Makros:

screenshot

Sub ConsolidateIn2Columns()
    Dim r As Range, pos As Integer, rowCurrent As Long, c As Integer, wsSource As Worksheet, wsDest As Worksheet
    pos = 1
    ' source sheet  
    Set wsSource = Sheets("Tabelle1")  
    ' destination sheet  
    Set wsDest = Sheets("Tabelle2")  
    ' get next free row in sheet 2  
    rowCurrent = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1  
    With wsSource
        ' for each row in sheets 1  
        For Each r In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            ' for 1 to last non empty column in row  
            For c = 1 To .Cells(r.Row, Columns.Count).End(xlToLeft).Column
                ' if cell is non empty  
                If .Cells(r.Row, c).Value <> "" Then  
                    ' copy value to destination sheet  
                    .Cells(r.Row, c).Copy Destination:=wsDest.Cells(rowCurrent, pos)
                    ' set column for next value  
                    pos = IIf(pos = 1, 2, 1)
                    ' increment row counter  
                    If pos = 1 Then rowCurrent = rowCurrent + 1
                End If
            Next
        Next
    End With
End Sub
Grüße Uwe
Mitglied: zitroooo
zitroooo 20.05.2022 um 11:25:19 Uhr
Goto Top
Vielen Lieben Dank!! Läuft Super.
Mitglied: colinardo
colinardo 20.05.2022 um 11:26:33 Uhr
Goto Top
👍

Wenns das dann war, den Beitrag bitte noch auf gelöst setzen. Merci.