将数据从一张纸复制到另一张纸，而不删除先前复制的行

Question

Sub CopyRows4()
    Dim rng As Range
    Dim cl As Range
    Dim str As String
    Dim RowEmpCrnt As Long
    Dim RowUpdCrnt As Long
    Dim WshtEmp As Worksheet

    Set WshtEmp = Sheets("Employee Data")
    Set rng = WshtEmp.UsedRange 'the range to search ie the used range
    str1 = "Executive" 'string to look for
    str2 = "Working"

    Sheets("Executive").UsedRange.Value = ""

    RowUpdCrnt = 3

    For Each cl In rng.Columns("E").Rows
        If cl.Text = str1 Then
          RowEmpCrnt = cl.Row
          If WshtEmp.Cells(RowEmpCrnt, "X").Value = str2 Then
            ' If both column "A" and column "E" contain the correct value
            ' copy it to next empty row on sheet 2
            cl.Range("a3:z3").Copy Sheets("executive").Cells(RowUpdCrnt, 1)

            RowUpdCrnt = RowUpdCrnt + 1
          End If
        End If
    Next cl
End Sub

在这里，我只想为满足条件的那些列/行从Sheets(Employee Data)复制数据，该Sheets(Employee Data)从A3列开始的。

Answer 1

首先，您的代码存在一些问题。

第1期

我从未见过以这种方式清除工作表： Sheets("updated").UsedRange.Value = ""

最明显的问题是它不清除任何格式。 我还认为，使用大型工作表会很慢。 我建议：

With Sheets("updated")
  .Cells.EntireRow.Delete
End With

要么

Sheets("updated").Cells.EntireRow.Delete

在这种情况下，使用With语句并没有多大区别，但是可以使代码更加清晰。 建议您在VBA编辑器的帮助中查找With statement

第2期

For Each cl In rng着眼于每一个细胞中rng ： A1 ， B1 ， C1 ，...， A2 ， B2 ， C2 ，...， A3 ， B3 ， C3 ，...，等等。如果rng是A1:Z500然后将检查所有1300个单元。

如果分散值为“是”的单元格，那么这将是您想要的。 但是，我假定所有值为“是”的单元格都在单个列中。 我在测试数据中使用了“ E”列； 您将必须用数据的正确列标识符替换E“。

For Each cl In rng.Columns("E")我只对列“ E”感兴趣。 这给出了E1:E500 ，这不是我想要的。

For Each cl In rng.Columns("E").Rows说我对列“ E”内的行感兴趣。 这样得出： E1 ， E2 ， E3 ，...

第3期

If cl.Text = str Then

这将为您提供在这种情况下所需的效果，但您需要了解这意味着什么，因为它不会在所有情况下均提供所需的效果。

cl.Value给出单元格的Excel值。 cl.Text （有一些例外）为您提供单元格的显示值。 所有这些例外都与一些较模糊的水平对齐方式相关，因此我将忽略它们。

对于字符串，Excel值和显示值将相同。 对于格式化的数值，它们可能不相同。 因此，如果Excel值123的格式为两位十进制数字，则显示值为123.00。

第4期

Sheets("updated").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

这非常聪明，但是：

• 在每种情况下都可能无法达到您的期望，
• 可能是某些行被覆盖的原因
• 它不必要地复杂。

我不喜欢“复杂”。 您可能可以查看此字符串并快速解释是什么，但能力较弱的同伴则不能。

老实说，我对我的rng.Columns("E").Rows不满意，我rng.Columns("E").Rows这也是“复杂”的。 它需要对Excel对象模型有扎实的了解才能知道它的作用。 我之所以只使用它是因为我想尽可能少地更改您的代码。 如果这是我的代码，我将避免使用此构造。

End(xlUp) ， End(xlDown) ， End(xlToLeft)和End(xlToRight)是键盘Ctrl + 向上箭头 ， Ctrl + 向下箭头 ， Ctrl + 左箭头和Ctrl + 右箭头控件的VBA等效项。

假设列A底部的单元格为空，则Cells(Rows.Count, 1).End(xlUp)名义上将光标移动到该列的顶部或第一个具有值的单元格。 Offset(1, 0)然后向下移动一行。

第一次使用此命令时，您已经清除了工作表，因此该命令移至该列的顶部，然后向下移至该列的顶部，因此第一输出行为2。也许这是您想要的，但您偶然获得它不是设计使然。

更重要的是，如果您从工作表“员工数据”中复制的任何行在A列中均没有值，则它将被覆盖。 这可能是您报告问题的原因。

我已经删除了此命令。 相反，我有一个新的变量RowUpdCrnt。 （对不起，在此答案的第一个版本中，我有RowEmpCrnt。）我将RowUpdCrnt初始化为1。如果要在顶部使用空白行，请将其更改为2。 然后，每次复制行时，我都会向RowUpdCrnt加1。

摘要

希望以上对您有意义。 询问是否不清楚。

我建议的代码

Sub CopyRows3()
    Dim rng As Range
    Dim cl As Range
    Dim str As String
    Dim RowUpdCrnt As Long

    Set rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
    str = "Yes" 'string to look for

    Sheets("updated").UsedRange.Value = ""

    RowUpdCrnt = 1

    ' In my test data, the "Yes"s are in column E.  This For-Each only selects column E.
    ' I assume all your "Yes"s are in a single column.  Replace "E" by the appropriate
    ' column letter for your data.
    For Each cl In rng.Columns("E").Rows
        If cl.Text = str Then
             'if the ell contains the correct value copy it to next empty row on sheet 2 &  delete the row
            cl.EntireRow.Copy Sheets("updated").Cells(RowUpdCrnt, 1)
            RowUpdCrnt = RowUpdCrnt + 1
        End If
    Next cl
End Sub 

新增了部分以回应评论：在移动行之前，必须在列A和X中都选择“是”

我认为这段代码符合其他要求：

Sub CopyRows4()
    Dim rng As Range
    Dim cl As Range
    Dim str As String
    Dim RowEmpCrnt As Long
    Dim RowUpdCrnt As Long
    Dim WshtEmp As Worksheet

    Set WshtEmp = Sheets("Employee Data")
    Set rng = WshtEmp.UsedRange 'the range to search ie the used range
    str = "Yes" 'string to look for

    Sheets("updated").UsedRange.Value = ""

    RowUpdCrnt = 1

    For Each cl In rng.Columns("A").Rows
        If cl.Text = str Then
          RowEmpCrnt = cl.Row
          If WshtEmp.Cells(RowEmpCrnt, "X").Value = str Then
            ' If both column "A" and column "E" contain the correct value
            ' copy it to next empty row on sheet 2
            cl.EntireRow.Copy Sheets("updated").Cells(RowUpdCrnt, 1)
            RowUpdCrnt = RowUpdCrnt + 1
          End If
        End If
    Next cl
End Sub