Als Antwort auf diesen Beitrag
Hallo zusammen,
ich benötige eure Hilfe bei der Befüllung einer Tabellen nach einem bestimmten Muster.
Ich habe eine Datentabelle mit >1000 Zeilen und 50 Spalten, und möchte 35 Einträge aus jeder Zeile in eine neue Tabelle untereinander schreiben,
wobei die erste Zelle in der neuen Tabelle immer den entsprechenden Wert aus Spalte A für jeden der 35 Einträge einer Zeile beibehällt.
Folgenden Code habe ich bereits gefunden, könnt ihr mir bitte Helfen diesen anzupassen oder
ihr habt eventuell noch eine bessere Idee um den Code so schnell wie möglich zu machen.
Sub DatenAusfuellen()
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim letzteZeileQuelle As Long
Dim letzteZeileZiel As Long
Dim i As Long
' Tabellenblätter definieren (Namen ggf. anpassen)
Set wsQuelle = ThisWorkbook.Sheets("Tabelle1")
Set wsZiel = ThisWorkbook.Sheets("Tabelle2")
' Letzte belegte Zeile in der Quelle ermitteln (Spalte A)
letzteZeileQuelle = wsQuelle.Cells(wsQuelle.Rows.Count, "A").End(xlUp).Row
' Schleife, die jede Zeile von Zeile 2 bis zum Ende durchläuft
For i = 2 To letzteZeileQuelle
' Bedingung: Wenn Spalte A nicht leer ist, dann...
If wsQuelle.Cells(i, 1).Value <> "" Then
' Nächste freie Zeile im Ziel-Tabellenblatt ermitteln
letzteZeileZiel = wsZiel.Cells(wsZiel.Rows.Count, "A").End(xlUp).Row + 1
' Daten aus der Quelle in das Ziel übertragen
' Spalte A (Quelle) -> Spalte A (Ziel)
wsZiel.Cells(letzteZeileZiel, 1).Value = wsQuelle.Cells(i, 1).Value
' Spalte B (Quelle) -> Spalte B (Ziel)
wsZiel.Cells(letzteZeileZiel, 2).Value = wsQuelle.Cells(i, 2).Value
End If
Next i
MsgBox "Übertragung abgeschlossen!", vbInformation
End Sub