Makro automatisch ausführen bei Zellenänderung VBA

Hallo Community,

ich habe ein Makro, dass mir automatisch die Zeilenhöhe mit Zeilenumbruch anpasst, wenn der Text zu lang ist (es wirkt auf das ganze Tabellenblatt aber mir geht es hauptsächlich um die verbundenen Zellen "D31:M31").
Dies passt auch soweit wenn ich das Makro nach Eingabe des geänderten Textes ausführe.

Nun benötige ich noch, dass das Makro automatisch ausgeführt wird, sobald sich der Text in der Zelle ändert. "Nehmen wir an da steht "hallo" und ich schreibe nun "hallo hans" hinein (natürlich viel länger, damit der Umbruch stattfindet).

Leider funktioniert es nicht mittels VBA, wenn ich den Text ändere.. Weiß jemand rat was ich falsch mache?

Danke für jeden Hinweis !!!


VBA in Tabelle1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$D$31:$M$31")) Is Nothing Then Zellenanpassen
End Sub

Und hier das Makro:

Sub Zellenanpassen()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub


VG
fireless

P.S.: Meine VBA Kenntnisse sind eher mau.. von daher nicht böse sein

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("$D$31:$M$31")) Is Nothing Then  
        For Each cell In Target
            If cell.Value <> "" Then  
                Zellenanpassen Target
            End If
        Next
    End If
End Sub

Sub Zellenanpassen(ByVal rngTarget As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If rngTarget.MergeCells Then
        With rngTarget.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = rngTarget.ColumnWidth
                For Each CurrCell In rngTarget
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
                Application.ScreenUpdating = True
            End If
        End With
    End If
End Sub