Copy Rows and Paste Special to New Worksheet

[ab0511]

Currently I have:
Set xRgS = Range("$A:$A")
If xRgS Is Nothing Then Exit Sub
Set xRgD1 = Range("'Sheet2'!$E$2")
If xRgD1 Is Nothing Then Exit Sub
Set xRgD = Range("'Sheet2'!$A$2")
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
xCell.EntireRow.Range("A1:D1").Copy xRgD.Offset(J, 0)
xCell.EntireRow.Range("J1:K1").Copy xRgD1.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub

which works if the cells I'm copying are just a value but I updated Sheet1 to have Formulas in columns J&K and I need to paste those as values to the new worksheet. I have tried a bunch of manipulations (one shown below) with the PasteSpecial but I can't seem to get this to work. Any recommendations?

Set xRgS = Range("$A:$A")
If xRgS Is Nothing Then Exit Sub
Set xRgD1 = Range("'Sheet2'!$E$2")
If xRgD1 Is Nothing Then Exit Sub
Set xRgD = Range("'Sheet2'!$A$2")
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
xCell.EntireRow.Range("A1:D1").Copy xRgD.Offset(J, 0)
xCell.EntireRow.Range("J1:K1").Copy xRgD1.Offset(J, 0).PasteSpecial(xlPasteValue)
J = J + 1
End If
Next
Application.CutCopyMode = False
End Sub

 

[Fluff]

You need to put it on two lines like

xCell.EntireRow.Range("J1:K1").Copy
xRgD1.Offset(J, 0).PasteSpecial(xlPasteValue)

 

[ab0511]

xCell.EntireRow.Range("J1:K1").Copy xRgD1.Offset(J, 0).PasteSpecial(xlPasteValue)

Thank you!! This helped!! Greatly appreciated!

 

[Fluff]

You're welcome & thanks for the feedback.