Excel 对于下一个循环-将基于值的单元格复制到另一个工作表中，并将其堆叠在表的末尾

我试图将值从一张图纸复制到另一张图纸，该图纸具有基于公式给定的特定值。每个月都会添加新条目，然后与现有列表进行比较。如果公式返回“NEW”，则应将此条目添加到列表中

我已经知道了如何找到这些条目并复制它们，但是我制作了代码，这样它就不会添加条目，而是将它们相互复制到同一个单元格中

以下是我得到的：

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row
        LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub 

这就是我目前的知识停止的地方。如果有人能指出我遗漏了什么，我会非常感激的

---

Tom

您需要增加

lastrow2

当您获得更多“新”单元格时，它不会改变

---

您需要增加

lastrow2

当您获得更多“新”单元格时，它不会改变

---

问题是，如果您计算循环外的最后一行，但在循环内使用它（多次），它将不会得到更新，粘贴的行将保持不变。请尝试以下方法：

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row

        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub 

---

这样，每次循环运行时，最后一行都会得到更新，并且会高出一行。

问题是，如果在循环外部计算最后一行，但在循环内部使用它（多次），则不会得到更新，粘贴的行将保持不变。请尝试以下方法：

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row

        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub 

---

这样，每次循环运行时，最后一行都会得到更新，并且会高出一行。

我尝试了您的方法，但它的操作与以前相同。这是因为您的最后一行计算基于第2列，但您正在粘贴第3列。将此

LastRow2=Sheets（“计算校正”）.单元格（Rows.Count，2）.结束（xlUp）.Row

更改为此

LastRow2=Sheets（“计算校正”）.单元格（Rows.Count，3）.结束（xlUp）.Row

。我认为这种方法比另一种方法更好的原因是，如果同时复制多个单元格，这种方法仍然有效。我尝试了这种方法，但它的效果与以前相同。这是因为您的lastrow计算是基于第2列的，但粘贴到第3列。将此

LastRow2=Sheets（“计算校正”）.单元格（Rows.Count，2）.结束（xlUp）.Row

更改为此

LastRow2=Sheets（“计算校正”）.单元格（Rows.Count，3）.结束（xlUp）.Row

。我认为这种方法比另一种方法更好的原因是，如果同时复制多个单元格，这种方法仍然有效。