VBA to fill down the formula next to Pivot table

[vostroxe]

Sub Macro1()

   Dim Lr As Long
   Lr = Range("A" & Rows.Count).End(xlUp).Row
   Range("C4").Formula = "=IF(A4<>'Grand Total',945100,2864602)"
   Range("C4").AutoFill Destination:=Range("C4:C" & Lr)
   
End Sub

I have tried to put above code to fill down the formula until the last row of pivot table. But debugging error appeared in formula line. From the pivot table, column A will be determine the last row and formula will be put at column C.

 

[vostroxe]

Issue solved. The solution is to record the VBA for the formula.

 

[Gian624]

Another way to do it which is more flexible if you add additional lines to the PivotTable in the future is to scan down to copy the formula in the first column next to the PivotTable, scan down to the last row in the PivotTable and then move back the column where the data will be copied, and paste the data to the top (or match it to the last row ow the previously copied data. The VBA looks like the following:

Range("G7:J7").Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 1).Select
If IsEmpty(ActiveCell) = True Then
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
End If

In this example, the formula I want to copy down is in cells G7-J7 (Range("G7:J7").Select). I copy the data in the first row (Selection.Copy). My PivotTable is the the left of the data I want to copy down so I move over to the left one cell, hence the -1 in "ActiveCell.Offset(0, -1).Select." Then I scan all the way to the bottom of the PivotTable data (Selection.End(xlDown).Select) and then move over back to the right again (ActiveCell.Offset(-1, 1).Select). I put some code in there that says if the cell below is blank, select everything above and paste the formula in the cells. This prevents accidently overwriting the first row formula.