Sub Кнопка_группы()
Dim LastRow As Long, j As Long, FreeRow As Long, FreeColumn As Long, LastColumn As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range(Cells(4, 2), Cells(LastRow, 8)).Clear
    FreeRow = 6
    FreeColumn = 2
    With Sheets("Группы")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        LastColumn = .Cells(6, Columns.Count).End(xlToLeft).Column
        For i = 6 To LastRow ' Step 27
            If .Cells(i, 2) = 1 Then
                For j = 2 To LastColumn Step 4
                    If .Cells(i, j + 1) <> "" Then
                        Range(.Cells(i - 3, j), .Cells(i + 17, j + 2)).Copy Cells(FreeRow, FreeColumn)
                        FreeColumn = FreeColumn + 4
                        If FreeColumn > 6 Then
                            FreeColumn = 2
                            FreeRow = FreeRow + 22
                        End If
                    End If
                Next
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set WorkRange = ActiveSheet.[B5].CurrentRegion
ActiveSheet.Unprotect Password:=""
Set WorkRange = ActiveSheet.[B5].CurrentRegion    If Not Intersect(Target, WorkRange.Cells((WorkRange.Cells.Count))) Is Nothing Then
        Set oDic = CreateObject("scripting.dictionary")
        arr = WorkRange.Resize(WorkRange.Rows.Count - 1, 3).Value
        On Error Resume Next
        For i = 1 To UBound(arr)
            oDic.Add LCase(CStr(arr(i, 1))) & ";" & LCase(CStr(arr(i, 3))), ""
        Next
        If oDic.exists(LCase(CStr(Target.Offset(, -2).Value) & ";" & CStr(Target.Value))) Then
            MsgBox "Данный человек уже изучает данный язык": Target.ClearContents
        End If
    End If
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, Password:=""
End Sub