Sub reduire()
Dim L1&, L2&, C1&, C2&, i&, j&, aux&
L1 = 6: L2 = Cells(Rows.Count, "b").End(xlUp).Row
C1 = 3: C2 = Rows(5).Find("MATIN", , xlValues, xlWhole).Column - 2
Application.ScreenUpdating = False
For j = C2 To C1 Step -1
aux = Application.WorksheetFunction.Count(Range(Cells(L1, j), Cells(L2, j)))
If aux = 0 Then Range(Cells(L1 - 1, j), Cells(L2 + 1, j)).Delete xlShiftToLeft
Next j
C2 = Rows(5).Find("MATIN", , xlValues, xlWhole).Column - 2
If C2 = 2 Then
Range(Cells(5, 1), Cells(Rows.Count, 1)).EntireRow.Delete
Else
For i = L2 To L1 Step -1
aux = Application.WorksheetFunction.Count(Range(Cells(i, C1), Cells(i, C2)))
If aux = 0 Then Cells(i, C1).EntireRow.Delete
Next i
Rows(5).Copy Rows(Cells(Rows.Count, "b").End(xlUp).Row + 2)
End If
End Sub