AW: Zellen mit gleichem Inhalt automatisch verbinden
22.05.2015 09:31:18
UweD
Hallo
per Makro..
Sub Verbinde()
On Error GoTo Fehler
Dim Zelle As Range, A As Integer, E As Integer, i As Integer
Const Z As Integer = 7 'Zeile
Const Sp1 As Integer = 13 'ab Spalte M
Const Sp2 As Integer = 220 'bis max Spalte HL
A = Sp1
With ActiveSheet
For Each Zelle In .Range(.Cells(Z, Sp1), .Cells(Z, Sp2)).SpecialCells( _
xlCellTypeConstants, 2).Cells
If Zelle Zelle.Offset(0, 1) And Zelle.MergeCells = False Then
E = Zelle.Column
Application.DisplayAlerts = False
.Range(.Cells(Z, A), .Cells(Z, E)).MergeCells = True
Application.DisplayAlerts = True
A = E + 1
End If
Next
End With
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
Application.DisplayAlerts = True
End Sub
Gruß UweD