Sub Макрос1() Dim i As Integer Dim x As Integer Dim n As Integer Dim m As Integer Dim s As Integer Dim lastRow As Long Dim a As Variant s = 3 i = 2 'для цикла n = 2 'начало массива x = 0 'хуита lastRow = 54 'последняя строка,нужно дописать For i = 2 To lastRow n = m + 2 If IsEmpty(Cells(i, "F")) = False Then If i <> n Then If IsEmpty(Cells(n, "F")) = True Then Cells(n, "F") = Cells(i, "F") Else Cells(n, "F") = Cells(n, "F") & "," & Cells(i, "F") Cells(i, "F") = Null End If End If End If If IsEmpty(Cells(i, "J")) = False Then Cells(n, "J") = Cells(i, "J") Cells(i, "J") = Null End If If IsEmpty(Cells(i, "K")) = False Then Cells(n, "K") = Cells(i, "K") Cells(i, "K") = Null End If If IsEmpty(Cells(i, "L")) = False Then Cells(n, "L") = Cells(i, "L") Cells(i, "L") = Null End If If IsEmpty(Cells(i, "N")) = False Then a = Range(Cells(i, "N"), Cells(i, "U")) Range(Cells(n, "N"), Cells(n, "U")) = a Range(Cells(i, "N"), Cells(i, "U")).ClearContents a = Range(Cells(i + 1, "N"), Cells(i + 1, "U")) Range(Cells(n + 1, "N"), Cells(n + 1, "U")) = a Range(Cells(i + 1, "N"), Cells(i + 1, "U")).ClearContents End If If Cells(i, "C") <> Cells(i + 1, "C") Then m = n n = i + 1 For x = m + 2 To n - 1 Rows(m + 2).Delete Shift:=xlUp Next i = m + 1 End If Next For s = 3 To lastRow Range(Cells(s, "A"), Cells(s, "M")).ClearContents s = s + 1 Next End Sub
