Hallo Hermann,
dir ist aber schon klar, dass beim Verbinden der Zellen nur die Werte in Spalte B erhalten bleiben, der Rest geht flöten?
Sub Makro1()
Dim rngBereich As Range
Dim rngZelle As Range
Dim loLetzte As Long
With Sheets("Tabelle1") 'anpassen
loLetzte = .Cells(.Rows.Count, 105).End(xlUp).Row 'letzte belegte Zelle in DA
Set rngBereich = .Range(.Cells(1, 105), .Cells(loLetzte, 105)) 'von Zeile 1 ggf. anpassen
Application.DisplayAlerts = False
For Each rngZelle In rngBereich
If rngZelle.Value = True Then
.Range(.Cells(rngZelle.Row, 2), .Cells(rngZelle.Row, 91)).Merge
With .Range(.Cells(rngZelle.Row, 2), .Cells(rngZelle.Row, 91))
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End If
Next rngZelle
End With
Application.DisplayAlerts = True
End Sub
Gruß Werner
|