Archive data from “sheet1” to next blank row of “sheet2”

Question

I have code to archive data from "sheet1" to "sheet2". It overwrites existing data in the "sheet2" rows from the previous archive exercise.

How do I have it seek the next blank row vs. overwriting existing data?

I have two header rows so it should commence with row 3.

Option Explicit

Sub Archive()
    Dim lr As Long, I As Long, rowsArchived As Long
    Dim unionRange As Range

    Sheets("sheet1").Unprotect Password:="xxxxxx"

    Application.ScreenUpdating = False
    With Sheets("sheet1")
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        For I = 3 To lr 'sheets all have headers that are 2 rows
            If .Range("AB" & I) = "No" Then
                If (unionRange Is Nothing) Then
                    Set unionRange = .Range(I & ":" & I)
                Else
                    Set unionRange = Union(unionRange, .Range(I & ":" & I))
                End If
            End If
        Next I
    End With

    rowsArchived = 0
    If (Not (unionRange Is Nothing)) Then
        For I = 1 To unionRange.Areas.Count
            rowsArchived = rowsArchived + unionRange.Areas(I).Rows.Count
        Next I
        unionRange.Copy Destination:=Sheets("sheet2").Range("A3")
        unionRange.EntireRow.Delete
    End If

    Sheets("sheet2").Protect Password:="xxxxxx"

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Operation Completed.  Total Rows Archived: " & rowsArchived
End Sub

Answer 1

Change

unionRange.Copy Destination:=Sheets("sheet2").Range("A3")

... to,

with worksheets("sheet2")
    unionRange.Copy _
      Destination:=.Cells(.rows.count, 1).end(xlup).offset(1, 0)
end with

This is like starting at the bottom row of the worksheet (eg A1048576) and tapping [ctrl+[↑] then selecting the cell directly below it.

The With ... End With statement isn't absolutely necessary but it shortens the code line enough to see it all without scolling across. unionRange has been definied by parent worksheet and cell range so there is no ambiguity here.

Answer 2

I'd propose the following "refactoring"

Option Explicit

Sub Archive()
Dim sht1 As Worksheet, sht2 As Worksheet

Set sht1 = Sheets("sheet1")
Set sht2 = Sheets("sheet2")

sht1.Unprotect Password:="xxxxxx"

With sht1.Columns("AB").SpecialCells(xlCellTypeConstants).Offset(, 1) '<== change the offset as per your need to point to whatever free column you may have
    .FormulaR1C1 = "=if(RC[-1]=""NO"","""",1)"
    .Value = .Value
    With .SpecialCells(xlCellTypeBlanks)
        .EntireRow.Copy Destination:=sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Offset(1, 0)
        MsgBox "Operation Completed.  Total Rows Archived: " & .Cells.Count
    End With
    .ClearContents
End With

sht2.Protect Password:="xxxxxx"

End Sub

just choose a "free" column in "Sheet1" to be used as a helper one and that'll be cleared before exiting macro. In the above code I assumed it's one column to the right of "AB"

Answer 3

The following approach worked for me! I'm using a button to trigger macro. Every time it takes the last row and append it to new sheet like a history. Actually you can make a loop for every value inside your sheet.

Sub copyProcess()
  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet
  Dim source_last_row As Long 'last master sheet row
  source_last_row = 0

  source_last_row = Range("A:A").SpecialCells(xlCellTypeLastCell).Row

  Set copySheet = Worksheets("master")
  Set pasteSheet = Worksheets("alpha")

  copySheet.Range("A" & source_last_row, "C" & source_last_row).copy

  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial 
  xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True


End Sub