Selected Answer
Asif
You say you want to paste extracted data below existing data. That's not a great idea to my mind (or will need some management so you don't have hundreds of rows of extracts) but I've added the date and time to each extract (using the VBA Now function). You'll see that I've added a new variable PasteCell (which is just below the last used row in column BL of the ALL_ENTRY sheet) which is convenient for some of the extra bits the macro does, especially the code in bold.
The modified Module 7 code below is commented so you can see what's happening. It now adds the 1 in BK (used with your XLOOKUP in column B for shifting data) and adds a datestamp in column B if there isn't one (I've removed the Worksheet_Change event which did this before).
Note that I've changed the With from ActiveSheet (to the logical name Sheet2) and moved the End With line further down. The bold text replaces the (shorter) xlCopy version since I had lots of problems problems with that failing for no obvious reason (all the elements existed and were correct) and this seems more reliable.
The revised code below should do what you want (I think):
Sub AdvanceFilter()
Dim Table As ListObject
Dim PT As PivotTable
Dim PasteCell As Range, n As Long 'variable, target cell for top left of pasted data
'Apply speed up options
Application.EnableEvents = False ' prevent event macros triggering
Application.ScreenUpdating = False ' to speed up macro
Application.Calculation = xlCalculationManual ' stop calcs
With Sheet2 ' specify the sheet
Set PT = .PivotTables("AdvanceFilterCriteriaPivot")
Set Table = .ListObjects("Master_ALL")
Set PasteCell = .Range("BL" & .Range("BL" & .Rows.Count).End(xlUp).Row + 3) 'get BL and last used row + 3
' change target for paste to the above and copy to BL:CI
Table.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=PT.TableRange1, Unique:=False
Table.Range.SpecialCells(xlCellTypeVisible).Copy Destination:=PasteCell
.ShowAllData
PasteCell.Offset(-1, 0).Value = Now 'add date and time above pasted data
PasteCell.Offset(-1, 1).Value = "Extract:" 'add name after the above
PasteCell.Resize(1, 28).Font.Color = vbBlack 'change pasted header row from white to black
'Put 1 in column BK (for XLOOKUP)
For n = PasteCell.Row + 1 To .Range("BL" & .Rows.Count).End(xlUp).Row
.Range("BK" & n).Value = 1
Next n
PasteCell.Offset(1, 5).Select ' select a cell in pasted data
'Turn calcs back on to evaluate XLOOKUP formulae
.Calculate
' then add date if there's a 1 in C but no date in B
For n = 3 To .Range("D" & .Rows.Count).End(xlUp).Row
If .Range("C" & n).Value = 1 And .Range("B" & n).Value = "" Then .Range("B" & n).Value = Date
Next n
End With
Application.EnableEvents = True 'reset events, screen and calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Paid items pasted and timestamps applied to B:C" 'tell user it's done
End Sub
Please use the attached revision to your workbook, in which BL:CI is currently blank so you can (if necessary) change the Auto Filter Criteria and run the macro (a few times to see it works).
Note that the conditional formatting in column C has been changed to that in the additional sheet called Conditional Formatting and the XLOOKUP formula in C now goes to rows 1999 (rather than the bigger 9999 you had)- you might change that if you find that the calculation within the macro isn't slowed down by that.
Hope this is what you wanted (or you can modify it slightly to suit)..
