Zellen verbinden und Zentrieren VBA

[Timon Galeazzi]

Hallo Timon,

ich teile auch die Ansicht von Klaus-Dieter, da verbundene Zellen viele Probleme bereiten können.
Dennoch hier eine Lösung, die man sicherlich noch eleganter hinbekommt:

Code:

Sub KW_verbinden()

   Dim KWZeile As Integer
   Dim StartSpalte As Byte
   Dim KWlSpalte As Byte
   Dim Spalte As Byte
   Dim KWNeu As Byte
   
   Application.DisplayAlerts = False
   
   KWZeile = 4
   StartSpalte = 2
   KWlSpalte = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
   
   KWNeu = StartSpalte
   
   For Spalte = StartSpalte To KWlSpalte
       If Cells(KWZeile, Spalte) <> "" Or Spalte = KWlSpalte Then
           If KWNeu < Spalte Then
               If Spalte <> KWlSpalte Then
                   With Range(Cells(KWZeile, KWNeu), Cells(KWZeile, Spalte - 1))
                       .HorizontalAlignment = xlCenter
                       .MergeCells = False
                       .Merge
                   End With
               Else
                   With Range(Cells(KWZeile, KWNeu), Cells(KWZeile, Spalte))
                       .HorizontalAlignment = xlCenter
                       .MergeCells = False
                       .Merge
                   End With
               End If
               KWNeu = Spalte
           End If
       End If
   Next
   
   Application.DisplayAlerts = True

End Sub

Viel Erfolg

So habe es nun nochmal versucht und war meine Dummheit die es nicht hat funktionieren lassen :16:

Jedoch hatte ich das Problem, dass sämtliche Zellen Verbunden wurden und die KW 52 rein geschrieben wird.
Gibt es einen Befehl den man noch einbauen könnte, der bei Jeder Zelle mit einem Inhalt endet und danach weiter macht? so dass alle KW angezeigt werden.

Liebe Grüsse
Timon