Sub autogroup()
Dim k
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
max_rows = ActiveSheet.UsedRange.Rows.Count
max_cols = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 1), Cells(max_rows, 1)).ClearOutline
Range("A" & max_rows + 1).Value = 1
For ii = 2 To max_cols - 2
i = max_cols - ii
For j = 1 To max_rows + 1
If Application.CountIf(Range(Cells(j, 1), Cells(j, i)), "<>") = 0 Then
If (flag = 1) Then
k = k
Else
k = j
End If
flag = 1
ElseIf (flag = 1) Then
Range(Cells(k, 1), Cells(j - 1, 1)).Rows.Group
k = 1
flag = 0
End If
Next
Next
Range("A" & max_rows + 1).Value = ""
End Sub
Dim k
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
max_rows = ActiveSheet.UsedRange.Rows.Count
max_cols = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 1), Cells(max_rows, 1)).ClearOutline
Range("A" & max_rows + 1).Value = 1
For ii = 2 To max_cols - 2
i = max_cols - ii
For j = 1 To max_rows + 1
If Application.CountIf(Range(Cells(j, 1), Cells(j, i)), "<>") = 0 Then
If (flag = 1) Then
k = k
Else
k = j
End If
flag = 1
ElseIf (flag = 1) Then
Range(Cells(k, 1), Cells(j - 1, 1)).Rows.Group
k = 1
flag = 0
End If
Next
Next
Range("A" & max_rows + 1).Value = ""
End Sub