Schleife for each mit Range Bereich

Hallo liebe Community,
ich habe ein Problem bei dem ich nicht so recht weiterkomme bzw. den richtigen Ansatz finde. Beispieldatei: https://www.herber.de/bbs/user/150020.xlsx.
Ich möchte mit einer Schleife (oder auch was anderes, wenn es besser passt) abfragen, ob ein nummerischer Wert in der Spalte A der Registerkarte Info vorhanden ist.
Wenn ja, soll
1. in der aktuellen Zeile die Werte aus den Spalten D bis G (Registerkarte Info) als Bereich1 (Registerkarte Organigramm) gesetzt werden
2. Bereich1.merge = true
3. dieser Bereich1 den Textinhalt aus Spalte B der aktuellen Zeile enthalten
4. in der aktuellen Zeile in Spalte D und E Werte jeweils +1 und die Spalten D bis G (Registerkarte Info) als Bereich2 (Registerkarte Organigramm) gesetzt werden
5. Bereich2.merge = true
6. dieser Bereich2 den Textinhalt aus Spalte C der aktuellen Zeile enthalten
Nächste Zeile
Könntet ihr mir weiterhelfen? Vielen Dank im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Udo und danke für den Code Vorschlag. Ich habe ein bisschen getüftelt und ihn angepasst, nach dem Ergebnis, welches ich mir wünsche. Funktioniert. Als nächstes möchte ich das er mir aus der Tabelle auf der Registerkarte Info nicht nur die Aktive Zelle abfragt, sondern alle Einträge. So nach dem Motto: Zelle A2 ist nicht leer dann untenstehenden Code, Zelle A3 ist nicht leer dann untenstehenden Code usw. Meinen bescheidenen Kenntnissen nach müsste das mit einer For each Schleife gehen, dann Do untenstehenden Code, dann Next und bis kein Eintrag mehr in Spalte A vorhanden ist?


Sub Text_Eintragen()
Dim R As Long, Bereich1 As Range, Bereich2 As Range
R = ActiveCell.Row
If Cells(R, 2) = "" Then
MsgBox " in dieser Zeile keine Einträge ! "
Exit Sub
End If
Set Bereich1 = Sheets(2).Range(Cells(Cells(R, 4), Cells(R, 5)).Address & ":" & Cells(Cells(R, 6), Cells(R, 7)).Address)
Set Bereich2 = Sheets(2).Range(Cells(Cells(R, 4) + 1, Cells(R, 5)).Address & ":" & Cells(Cells(R, 6) + 1, Cells(R, 7)).Address)
With Bereich1
.MergeCells = True
.Value = Sheets(1).Cells(ActiveCell.Row, 2).Value
End With
With Bereich2
.MergeCells = True
.Value = Sheets(1).Cells(ActiveCell.Row, 3).Value
End With
Set Bereich1 = Nothing
Set Bereich2 = Nothing
End Sub

Sub Text_Eintragen() Dim R As Long, Bereich1 As Range, Bereich2 As Range For Each Rng In Range(Range("Tabelle1[[Lfd. Nr.]]").Address) R = Rng.Row Set Bereich1 = Sheets(2).Range(Cells(Cells(R, 4), Cells(R, 5)).Address & ":" & Cells(Cells(R, 6), Cells(R, 7)).Address) Set Bereich2 = Sheets(2).Range(Cells(Cells(R, 4) + 1, Cells(R, 5)).Address & ":" & Cells(Cells(R, 6) + 1, Cells(R, 7)).Address) With Bereich1 .MergeCells = True .Value = Sheets(1).Cells(R, 2).Value End With With Bereich2 .MergeCells = True .Value = Sheets(1).Cells(R, 3).Value End With Set Bereich1 = Nothing Set Bereich2 = Nothing Next Rng End Sub

Beliebteste Forumthreads (12 Monate)

Schleife for each mit Range Bereich

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife for each mit Range Bereich

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread