Verschiedene Bereiche in For-Schleife durchlaufen

Hallo liebe VBA-Gemeinde,
ich bekomme es einfach nicht hin und nach stundenlanger Suche hier mein Anliegen.
Eigentlich ist es ganz einfach. Ich habe in der Mappe 4 Bereiche definiert.
Jeder dieser Bereiche soll kopiert werden, neben den "Original-Werten" eingefügt und absteigend sortiert werden. Der Code funktioniert auch soweit.
Jedoch würde ich gerne meinen Code kürzen. Bisher habe ich den Folgenden Code viermal _
hintereinander kopiert und das Wörtchen "Erreichbarkeit" durch eines der anderen definierten _
Bereiche ersetzt. Ich hatte vor dies variabel zu halten und mit einer For-Schleife zu _
durchlaufen. Leider ohne Erfolg. Würde sich jemand erbarmen und einem verzweifelten Neuling _ helfen? Über jeden Hinweis wäre ich dankbar. Hier noch der Code welcher für jeden Bereich ausgeführt werden soll.


Private Sub Erreichbarkeit()
'Definierten Bereich Kopieren
Set Bereich = Range("Erreichbarkeit")
Bereich.Select
Selection.Copy
'Definierten Bereich Einfügen
ActiveCell.Offset(0, 3).PasteSpecial xlValues
Application.CutCopyMode = False
'Bereich sortieren
Set Bereich = Selection
Bereich.Sort _
Key1:=Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)), Order1:=xlDescending, _
Header:=xlYes, orderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Erreichbarkeit() Dim Arr, Z, RNG Arr = Array("Erreichbarkeit", "BereichB", "BereichC", "BereichD") For Each Z In Arr With ActiveSheet Set RNG = .Range(Z).Offset(0, 3) 'Werte übertragen RNG.Value = .Range(Z).Value 'sortieren With .Sort .SortFields.Clear .SortFields.Add2 Key:=RNG, _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange RNG .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Next End Sub

Private Sub Zusammen() Dim Arr, Z, RNG Arr = Array("Bereich4", "Bereich3", "Bereich2", "Bereich1") For Each Z In Arr With ActiveSheet Set RNG = .Range(Z).Offset(0, 3) 'Werte übertragen RNG.Value = .Range(Z).Value RNG.Select RNG.Sort _ Key1:=Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)), Order1:=xlDescending, _ Header:=xlYes, orderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End With Next End Sub

Private Sub Zusammen() Dim Arr, Z, RNG, B Set B = ActiveCell Arr = Array("Erreichbarkeit", "Remote", "Field", "ETM") For Each Z In Arr With ActiveSheet Set RNG = .Range(Z).Offset(0, 3) 'Werte übertragen RNG.Value = .Range(Z).Value RNG.Sort _ Key1:=Range(RNG.Offset(0, 1), RNG.Offset(0, 1)), Order1:=xlDescending, _ Header:=xlYes, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End With Next B.Select End Sub

Beliebteste Forumthreads (12 Monate)

Verschiedene Bereiche in For-Schleife durchlaufen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Verschiedene Bereiche in For-Schleife durchlaufen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread