Makro ausführen bis Zellen leer sind

Sub Rohdaten_Einfügen() ' Rohdaten_Einfügen Makro ' Rohdaten Transformieren ' Tastenkombination: Strg+e Columns("A:A").ColumnWidth = 37 Sheets("Transformiert").Select Range("A2:J2").Select Selection.ListObject.ListRows.Add (1) Sheets("Rohdaten").Select Range("A6,A7,A10,A16,A17,A19,A23,A25,A30,A31").Select Range("A31").Activate Selection.Copy Sheets("Transformiert").Select Range("A2:J2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("Rohdaten").Select Range("A1:A33").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
so allgmein is aufgezeichneter Code ganz praktisch, aber nicht sehr schön und außerdem sehr rechenaufwändig
Bereich.Select
Selection.Aktion
lässt sich meist zusammenfassen zu Bereich.Aktion

Sub Rohdaten_Einfügen()
' Rohdaten_Einfügen Makro
' Rohdaten Transformieren
' Tastenkombination: Strg+e
Sheets("Transformiert").Range("A2:J2").ListObject.ListRows.Add (1)
Sheets("Rohdaten").Range("A6,A7,A10,A16,A17,A19,A23,A25,A30,A31").Copy
Sheets("Transformiert").Range("A2:J2").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Sheets("Rohdaten").Range("A1:A33").Delete Shift:=xlUp
End Sub

Das hier wäre nur dein Makro zusammengefasst. Probier es nochmal aus und versuch den Unterschied zu verstehen.
Wenn du Aktionen wiederholen möchtest gibt es 2 Möglichkeiten


For i = 1 To X
Aktion
Next i

Damit wird die Aktion X mal wiederholt. Setze Für X eine Zahl deiner Wahl ein und die Aktion wiederholt sich.


Do While [Bedingung]
Aktion
Loop

Damit wird die Aktion solange wiederholt, wie die Bedingung wahr ist.
Eine Bedingung wäre z.B.

Sheets("Rohdaten").Range("A6").Value  ""

Diese Bedingung bedeutet Wert der Zelle A6 ungleich nichts
Als solange A6 nicht leer ist wiederhole die Aktion.


Sub Rohdaten_Einfügen()
' Rohdaten_Einfügen Makro
' Rohdaten Transformieren
' Tastenkombination: Strg+e
Do While Sheets("Rohdaten").Range("A6").Value  ""
Sheets("Transformiert").Range("A2:J2").ListObject.ListRows.Add (1)
Sheets("Rohdaten").Range("A6,A7,A10,A16,A17,A19,A23,A25,A30,A31").Copy
Sheets("Transformiert").Range("A2:J2").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Sheets("Rohdaten").Range("A1:A33").Delete Shift:=xlUp
Loop
End Sub

Probier dich mal selber daran aus.
Schöne Grüße Felix

Beliebteste Forumthreads (12 Monate)

Makro ausführen bis Zellen leer sind

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread