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.
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.
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-Key: 2848739696
Url: https://administrator.de/contentid/2848739696
Ausgedruckt am: 28.03.2024 um 22:03 Uhr
3 Kommentare
Neuester Kommentar
Servus,
so wie ich das interpretiert habe solltest du hiermit klar kommen.
Grüße Uwe
so wie ich das interpretiert habe solltest du hiermit klar kommen.
Ausgangslage in "Tabelle1":
Ergebnis in "Tabelle2" nach Anwenden des Makros:
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