I have some VBA code that links to a button when clicked the data on Sheet1 will copy to Sheet2 and clear the data on Sheet1. My problem is the formulas and formatting on Sheet1 will ultimately end up being erased as well. In the past i was able to use constants under find and select but this is not working. Is there any code I could add to make sure Sheet1 keeps the formulas and formatting, I do not need them on sheet2 but if it is easier to keep them than that would work as well
Sub CopyPasteClear()
'Source
Const cSource As String = "Receive Tracker" ' Worksheet Name
Const cFirstRsrc As Long = 7 ' First Row Number
Const cClr As String = "A7,J7" ' Clear Cells
Const cRowClr As Long = 7 ' First Clear Row
Const cFinal As String = "A7" ' Final Select Cell Address
' Target
Const cTarget As String = "ReceiveData" ' Worksheet Name
' Both
Const cCol1 As Variant = "A" ' First Column Letter/Number
Const cCol2 As Variant = "J" ' Second Column Letter/Number
Dim vntVal As Variant ' Value Array
Dim LastRsrc As Long ' Source Last Row Number
Dim LastRtgt As Long ' Target Last Row Number
' Source Range into Source Array
With ThisWorkbook.Worksheets(cSource)
' Calculate Source Last Row Number of First Column.
LastRsrc = .Columns(cCol1).Find("*", , -4123, , 2, 2).Row
' Prevent copying data above First Row. Rows from First Row to
' one less than First Clear Row will still be copied. To prevent this,
' change cFirstRsrc to cRowClr in the following line only.
If LastRsrc < cFirstRsrc Then Exit Sub
' Copy Source Range into Source Array
vntVal = .Range(.Cells(cFirstRsrc, cCol1), .Cells(LastRsrc, cCol2))
End With
' Source Array into Target Range
With ThisWorkbook.Worksheets(cTarget)
' Calculate Target Last Row Number of First Column.
LastRtgt = .Columns(cCol1).Find("*", , -4123, , 2, 2).Row
' Copy Source Array into Target Range. Note that Target Last Row
' Number has to be inreased by 1 to get the first empty row.
.Cells(LastRtgt + 1, cCol1) _
.Resize(UBound(vntVal), UBound(vntVal, 2)) = vntVal
End With
With ThisWorkbook.Worksheets(cSource)
' Prevent deleting data above First Clear Row.
If LastRsrc < cRowClr Then Exit Sub
' Clear contents of Clear Cells and modified Source Range.
Union(.Range(cClr), .Range(.Cells(cRowClr, cCol1), _
.Cells(LastRsrc, cCol2))).ClearContents
' Activate Source Worksheet if it is not active (not the ActiveSheet).
' The following Select method will produce an error if the program
' was started while a different worksheet than the Source Worksheet
' was active.
If .Parent.ActiveSheet.Name <> .Name Then
.Activate
End If
' Select Final Select Cell.
.Range(cFinal).Select
End With
End Sub
