VBA Paste the formula that was copied in D3 (Last Cell With Data) to Next Empty Cell (D4 in this case)

[CrashOD]

I'm trying to get it if click New Tax Cert Button to Copy the last Cell in $d:$d with date(the formula) to the cell just below it for D, E. Then when this is done if possible to take the cells that the data was copied from (after pasting the formula below it) to past the value.


Sub New_Tax_Cert_Copy()
'
' New_Tax_Cert_Copy Macro
'
Sheets("List").Select

Dim lr As Long

Range("D" & Rows.Count).End(xlUp).Select
Selection.Copy
Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormula, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Range("D1").End(xlDown).Offset (1)

' Range("D" & Rows.Count).End(xlUp).Offset(1).Paste

' Range("D" & Rows.Count + 1).Select




' lr = Columns("D").Find(What:="", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' n Error Resume Next
' Range("D1:D" & lr).SpecialCells(xlBlanks).Select = Selection.Paste

On Error GoTo 0



' Range("D" & Rows.Count).End(xlUp).Select
' Selection.Copy
' Worksheets("List").Range("D1").End(xlDown).Row 1

' Cells(Rows.Count, 1).End(xlUp).Select


' Range("D").End(xlDown).Row 1

' Range("D" & Rows.Count).End(xlUp).Row 1


' Cells(2, Range(D).End(xlUp).Row + 1).Paste

' Range("E" & Rows.Count).End(xlUp).Select
' Selection.Copy
' Cells(2, Range(E).End(xlUp).Row + 1).Paste

' Range("D" & Rows.Count).End(xlUp).Select
' Selection.Copy
' Range("D" & Rows.Count).End(xlUp).Offset(1).Paste

' Range("E" & Rows.Count).End(xlUp).Select
' Selection.Copy
' Range("E" & Rows.Count).End(xlUp).Offset(1).Paste

' Range("F" & Rows.Count).End(xlUp).Offset(1).Select
' Range("F" & Rows.Count).End(xlUp).Select

' MsgBox "Only Enter Properly Parcel & Requester Info!!!"

'
End Sub

East Cameron Township - Copy.xlsm
	A	B	C	D	E	F
1
2	Paid	$	PARCEL #	OWNERS	ADDRESS	REQUESTED BY:
3		1	001-00-077-086-B	ARTMAN CLIFFORD P/CAROL ANN	4922 UPPER RD	Test Company
4		1	001-00-077-086
5
6
7
8
9
10
11
12
13
14
15
List

Cell Formulas
Range	Formula
D3	D3	=INDEX('C:\Users\pmill\Google Drive\2022\[2022 - ECT - Real Estate - Copy.xls]Real Estate'!$A$1:$P$65536,MATCH(C3,'C:\Users\pmill\Google Drive\2022\[2022 - ECT - Real Estate - Copy.xls]Real Estate'!$P$1:$P$65536,0),1)
E3	E3	=INDEX('C:\Users\pmill\Google Drive\2022\[2022 - ECT - Real Estate - Copy.xls]Real Estate'!$A$1:$R$65536,MATCH(C3,'C:\Users\pmill\Google Drive\2022\[2022 - ECT - Real Estate - Copy.xls]Real Estate'!$P$1:$P$65536,0),18)

 

[CrashOD]

the below code for
With ISheet
With ISheet2
copies and past code to next empty cell how do i get the cell above were the formula was pasted to copy and paste value?

Sub New_Tax_Cert_Copy()
'
' New_Tax_Cert_Copy Macro
'
Sheets("List").Select

Dim iBook As Workbook
Dim iSheet As Worksheet
Set iBook = ThisWorkbook
Set iSheet = Sheets("List")
With iSheet
If IsEmpty(Range("D2").Offset(1, 0)) Then
Range("D2").Copy Range("D2").Offset(1, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(1, 0)
End If
End With

Dim iBook2 As Workbook
Dim iSheet2 As Worksheet
Set iBook2 = ThisWorkbook
Set iSheet2 = Sheets("List")
With iSheet2
If IsEmpty(Range("E2").Offset(1, 0)) Then
Range("E2").Copy Range("E2").Offset(1, 0)

Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(1, 0)
End If
End With

Dim iBook3 As Workbook
Dim iSheet3 As Worksheet
Set iBook3 = ThisWorkbook
Set iSheet3 = Sheets("List")
With iSheet3
If IsEmpty(Range("D2").Offset(0, 0)) Then
Range("D2").Copy Range("D2").Offset(0, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(0, 0)
End If
End With

Dim iBook4 As Workbook
Dim iSheet4 As Worksheet
Set iBook4 = ThisWorkbook
Set iSheet4 = Sheets("List")
With iSheet4
If IsEmpty(Range("E2").Offset(0, 0)) Then
Range("E2").Copy Range("E2").Offset(0, 0)

Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(0, 0)
End If
End With
MsgBox "Only Enter Properly Parcel & Requester Info!!!"


End Sub