Move a Record to Archive

On the attached, what would be the proper VBA code for 'when cell E6 is not blank, cut the total record (A6:E6) and paste it to the next available row on the Archive tab'?

Adding how to re-sort cells A3:E7 on the "Input Log" tab by Name (the data1 field) so there is then not a blank would be even better!

Thanks a lot in advanced.

Are you adding one record at a time from the input sheet, why only copy Row ^ when you have more data there?

Yes, we would be adding one row at a time. I am not sure what the symbol ^ means, but we only want a row record copied IF the cell in column E is populated. Notice the example row is the only one with something in E that's populated.

How is else can I clarify my quesiton? Thanks for your help!

Can I clarify the question any further? I thought this one would be simpe for some, but I guess I am wrong!

Hi dreicer_Jarr, See if the attached and this code does what you need.

Option Explicit
Sub ArchiveRecords()

Dim RowCtr As Double
Dim LastRowI As Double
Dim LastRowA As Double

    LastRowI = Cells(Rows.Count, "A").End(xlUp).Row
    
    For RowCtr = 4 To LastRowI
        If Cells(RowCtr, "E") <> "" Then
            LastRowA = Worksheets("Archive").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Range(Cells(RowCtr, "A"), Cells(RowCtr, "E")).Copy _
             Destination:=Worksheets("Archive").Cells(LastRowA, "A")
            Rows(RowCtr).EntireRow.Delete
            RowCtr = RowCtr - 1
        End If
    Next RowCtr
End Sub

It worked perfect except it lead me to another issue. The attached is an example but the "input log" tab has a formula that is now losing its reference. This is likely because an entire row is being deleted and not just a range. Any ideas on how this can be avoided or fixed? I edited the solved example to make this easier. The macro would need to run without there being any errors in the data6 column.

Thanks again all!

Try adding three lines of code to put the formula back like:

Option Explicit
Sub ArchiveRecords()

Dim RowCtr As Double
Dim LastRowI As Double
Dim LastRowA As Double

    LastRowI = Cells(Rows.Count, "A").End(xlUp).Row
    
    For RowCtr = 4 To LastRowI
        If Cells(RowCtr, "E") <> "" Then
            LastRowA = Worksheets("Archive").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Range(Cells(RowCtr, "A"), Cells(RowCtr, "E")).Copy _
             Destination:=Worksheets("Archive").Cells(LastRowA, "A")
            Rows(RowCtr).EntireRow.Delete
            RowCtr = RowCtr - 1
        End If
    Next RowCtr
    LastRowI = Cells(Rows.Count, "A").End(xlUp).Row
    Cells(5, "F").Formula = "=F4+1" 'Formula of your choice
    Cells(5, "F").Copy Destination:=Range("F6:F" & LastRowI)

End Sub

For those that read this in the future, the second problem I asked about was solved by me changing the formula to =row() that way the reference is always correct. The first question I asked was answered perfectly above. Thanks!