Do
k = k + 1 
max = 0 'введем переменную для учета максимального количества закрытия единицами нулей
For i = 1 To UBound(massiv1, 1)
    Perekritie = 0
        For j = 1 To UBound(massiv1, 1)
                If PoleSovpaden(1, j) = 0And PoleSovpaden(i, j) = 1 Then Perekritie = Perekritie + 1
        Next j
        PerekritieM(i) = Perekritie 'запоминаем сумму перекрытий i-ой строки
        If PerekritieM(i) > max Then
           max = PerekritieM(i)
           n = i ' переменная для номера строки имеющего максимальное совпадение с первой строкой.
        If max = Pred_Max Then Exit For 'если достигнуто предыдущее число совпадений то нет смысла дальше вести цикл
        Else
        End If
Next i
 Pred_Max = max 'запоминание предыдущего максимального числа совпадений
 If max = 0 Then Exit Do ' - сформировалась строка из единиц, либо больше нечем заменять..
 ReDim Preserve NStroki(k)
 NStroki(k) = n

MsgBox "колво совпадений: " & max & "  Номер строки: " & n & "  Строка по счету - " & k
zamena = 0 'количество замен будет равно количеству максимальных перекрытий.....,
For i = 1 To UBound(massiv1, 1)
    If PoleSovpaden(1, i) = 0 And PoleSovpaden(n, i) = 1 Then
    PoleSovpaden(1, i) = 1 ' меняем НУЛИ на ЕДИНИЦЫ в ИСХОДНИКЕ, меняем ИСХОДНИК до тех пор пока он не будет весь из ЕДИНИЦ
    zamena = zamena + 1  ' достигнуто  (число max), то нет смысла дальше продолжать цикл
    End If
    If zamena = max Then Exit For
Next i
Loop

Dim sh As Worksheet
Dim mas1() As Variant 
Dim mas2() As Variant 
For Each sh In ThisWorkbook.Worksheets
 j=1   
      For i = 1 To 130 '130 навскидку потому что не знаю до конца сколько у меня рабочих на листе.
        p = sh.Cells(i + 13, 6) - фамилии начинаются с 14 строки, и присутствую НЕ В КАЖДОЙ строке.
   If p = 0 Or p = "" Or  Then  GoTo 10 'ускорить таким образом хотел, чтоб сразу на след клетку если пусто
      Else

       mas2(j, 1) = sh.Cells(i + 13, 6)'формируется массив с фамилией... 
            mas2(j, 2) = sh.Cells(i + 13, 9)' ..и суммой
End If
o = o + 1
10    Next i