asked on

Add rows below pivot tables

I need a macro that would loop through all worksheets and if there is a pivot table or tables on the sheet that the last cell in the pivot table is touching another cell with information in it then the macro would insert 10 rows below the pivot table.

Thanks,
Montrof

Rory Archibald

Try this:

Sub PivotExpander()
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim rNext As Range
    For Each ws In ActiveWorkbook.Worksheets
        For Each pt In ws.PivotTables
            With pt.TableRange1
                If Application.CountA(.Offset(.Rows.Count).Resize(1)) Then .Offset(.Rows.Count).Resize(10).EntireRow.Insert
            End With
        Next pt
    Next ws
End Sub

Open in new window

montrof

ASKER

That is great one last question is there a way to group that data and then close the group.

Thanks,
montrof

montrof

ASKER

Sorry I think I need to be a little clearer. I want to group the new rows and the pivot into one group and then close the group.

ASKER CERTIFIED SOLUTION

Rory Archibald

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

montrof

ASKER

Always amazed at the level of help. Thank you so much

Montrof

montrof

ASKER

Sorry one more question it seems like it is not adding the rows below a lot of the pivots. I want it to add them for any pivot and maybe I miss stated that previously. I would appreciate your help if you can.

montrof

ASKER

One more thing if there is not 10 blank rows below the pivot table add them otherwise do nothing

Rory Archibald

The code only adds rows if there is data in the row immediately below the pivot since that is what you asked for. :)

montrof

ASKER

IS there a way I could change it to look for 10 blank rows and if not add them? If needed I can open another question.

Thanks,
Montrof

montrof

ASKER

I figured it out thanks for the help, have a good night.

Montrof