Private Sub Worksheet_Change(ByVal Target As Range)
Dim sTxt As String
Dim j As Byte
    If Not Intersect(Range("B:C,F:F,K:K,M:M"), Target) Is Nothing Then
        Application.EnableEvents = False 'Отключили
        With Target
            Select Case .Column
            Case 2: j = 1
            Case 3: j = 4
            Case 6: j = 27
            Case 11: j = 28
            Case 13: j = 29
            End Select
            sTxt = Cells(.Row, j).Value
            Cells(.Row, j).Value = Cells(.Row, .Column).Value
            If Len(sTxt) > 0 Then Cells(.Row, j).Value = Cells(.Row, j).Value & "; " & sTxt
        End With
    End If
    Application.EnableEvents = True 'Включили
End Sub