如何编辑 VBA 代码以粘贴到不同的位置

Question

我正在根据连续单元格的值分离数据。在此示例中，如果 Y 列中的任何单元格 =“X”，那么它会将整行粘贴到正确的选项卡中。

我正在使用我在此处找到的一些代码，它们可以完美地获取数据并将其转储到新选项卡中。这对于每周生成新数据很有用，但我还想要一个标签，将数据粘贴到现有数据的末尾以保持年度统计。

这是我正在使用的代码。

Sub Paste()

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Data All")
Set Target = ActiveWorkbook.Worksheets("Data X")

j = 2
For Each c In Source.Range("Y1:Y300")
    If c = "X" Then
       Source.Rows(c.Row).Copy Target.Rows(j)
       j = j + 1
    End If
Next c
End Sub

以我有限的理解，“j = 2”部分似乎意味着它从第2行开始粘贴。

我尝试使用类似的代码将其粘贴到下一个可用行：Last Row Paste to different Worksheet VBA

我使用了“dim lRow As Long”并删除了对 j 的引用，然后尝试制作它

Source.Rows(c.Row).Copy Target.Rows(lRow)

但这似乎不起作用。有人有见识吗？我想让它尽可能简单。

Answer 1

Sub Jeeped()

'Declare & Set relevant Sheets
Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("Data All")
Dim wsP As Worksheet: Set wsP = ThisWorkbook.Sheets("Data X")

'Declare LR variables and range variables
Dim C As Range, CopyMe As Range
Dim cLR As Long, pLR As Long

'Determine last rows on both sheets
cLR = wsC.Range("Y" & wsC.Rows.Count).End(xlUp).Row
pLR = wsP.Range("A" & wsP.Rows.Count).End(xlUp).Row

'Loop through range and create collection (UNION) of cells
For Each C In wsC.Range("Y1:Y" & wsC)
    If C = "X" Then
        If Not CopyMe Is Nothing Then
            Set CopyMe = Union(CopyMe, C)
        Else
            Set CopyMe = C
        End If
    End If
End If

'If any cells are found, paste them all at once here
If Not CopyMe Is Nothing Then
    CopyMe.EntireRow.Copy
    wsP.Range("A" & pLR).PasteSpecial xlPasteValues
End If

End Sub