Question

我有以下代码来存档＆＃34; sheet1＆＃34; to＆＃34; sheet2＆＃34;：并且在执行时，它会覆盖已经存在于＆＃34; sheet2＆＃34;中的现有数据。以前存档练习中的行。寻求帮助让代码寻找下一个空行而不是覆盖现有数据。我有2个标题行，所以它应该从row3开始。选项明确

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

更改

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

...到，

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

这就像从工作表的底行开始（例如A1048576）并点击[ctrl + [↑]然后选择正下方的单元格。

With ... End With statement并非绝对必要，但它会缩短代码行，足以让所有人都能看到它而不会喋喋不休。父unionRange已被父工作表和单元格区域定义，因此这里没有歧义。

Answer 2

我建议以下＆＃34;重构＆＃34;

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

只需选择一个＆＃34;免费＆＃34;列＆＃34; Sheet1＆＃34;用作帮助程序，并在退出宏之前清除。在上面的代码中，我假设它是＆＃34; AB＆＃34;

右侧的一列

Answer 3

以下方法对我有用！我正在使用一个按钮来触发宏。每次花费最后一行并将其像历史记录一样添加到新表中。实际上，您可以为工作表中的每个值进行循环。

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

归档来自＆＃34; sheet1＆＃34;的数据到＆＃34; sheet2＆＃34;

3 个答案: