Hi JLoKyM..

Please use code tag for Codes.. otherwise it really hard to read.. and you may also get an idea that.. "No One knows the answer.."

BTW.. try this..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
    If Intersect(Target, rngDV) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        Select Case Target.Address
            Case "$D$8", "$D$13", "$D$18", "$D$21"
                If Target.Value = "" Then GoTo exitHandler
                    If Target.Offset(1, 0).Value = "" Then
                        Target.Offset(1, 0).Value = Target.Value
                    Else
                        Target.Offset(1, 0).Value = _
                        Target.Offset(1, 0).Value _
                        & ", " & Target.Value
                    End If
        End Select
    End If
exitHandler:
    Application.EnableEvents = True
End Sub