Copying cells from one sheet to another sheet

[de_haviland]

I have finally pulled together a way of finding my old key number and generating a new unique number then erasing the old key number and the other cells in the row which hold information about that key.

But i want to copy all the cells which contain information for the old key number to sheet 2 on my excel workbook before the new key number is assigned to the row and the cells are overwritten.

Can someone help me with some VB script?

Thanks De_haviland

Private Sub CommandButton1_Click()
    Dim strDeleteKey As String
    Dim strNewKey As String
    Dim strFirstAddress As String
    Dim strMsg As String
    Dim strKeySearchResult As String
    Dim strKeyPrefix As String
    Dim strKeyAddress As String
    Dim rngKeySearch As Range
    Dim rngKeySearch2 As Range
    Dim intKeyCount As Integer
    Dim intNewKey As Integer
    Dim intKeySearchResult As Integer
    Dim varHighestValue As Variant
    Unload Kng
    Dim arrKeys(2) As Integer
    
    intKeyCount = 0
    
    strDeleteKey = InputBox("Re-enter number to permanantly delete")
    
    If Trim(strDeleteKey) <> "" Then
        With Sheets("Properties on Keywatch").Range("A:A")
        
            Set rngKeySearch = .Find(What:=strDeleteKey, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
        ActiveCell.EntireRow.Copy
                            
            If Not rngKeySearch Is Nothing Then
                strKeyAddress = rngKeySearch.Address
                strKeyPrefix = Left(strDeleteKey, 2)
                
                Set rngKeySearch2 = .Find(What:=strKeyPrefix, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                
                If Not rngKeySearch2 Is Nothing Then
                    strFirstAddress = rngKeySearch2.Address
                    Do
                        strKeySearchResult = Right(CStr(rngKeySearch2.Text), 3)
                        intKeySearchResult = CInt(strKeySearchResult)
                    
                        arrKeys(intKeyCount) = intKeySearchResult
                
                        Set rngKeySearch2 = .FindNext(rngKeySearch2)
                    
                        intKeyCount = intKeyCount + 1
                    Loop While Not rngKeySearch2 Is Nothing And rngKeySearch2.Address <> strFirstAddress
                End If               
                
                varHighestValue = WorksheetFunction.Max(arrKeys)
            
                intNewKey = CInt(varHighestValue) + 1
                
                If intNewKey = 99 Then
                    strMsg = "No key number slots remaining on hook " & strKeyPrefix
                Else
                    strNewKey = Left(strDeleteKey, 1) & CStr(intNewKey)
                
                    Application.Goto rngKeySearch, True
                
                    ActiveCell = strNewKey
                    ActiveCell.Offset(0, 1) = ""
                    ActiveCell.Offset(0, 2) = ""
                    ActiveCell.Offset(0, 3) = ""
                    ActiveCell.Offset(0, 4) = ""
                
                    strMsg = "Key " & strDeleteKey & " has been deleted. Key " & strNewKey & " created ready for use."
                End If
                    MsgBox (strMsg)
            Else
                MsgBox "Key does not exist. Please re-enter"
            End If
        End With
    End If
    Sheets("Sheet2").Select
    Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.PasteSpecial
           
End Sub