1

I am working on separating out data according to the value of a cell in a row. In this example I have it so that if any cells in Column Y = "X" then it will paste the entire row into the correct tab.

I am using some code that I found on here that works perfectly to take the data and dump it into the new tab. This is good for generating new data weekly, but I also want a tab that will paste the data on the end of existing data to keep a yearly tally.

This is the code I'm working with.

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

With my limited understanding, it seems that the "j = 2" part means that it begins pasting on the 2nd row.

I tried using this similar code that pastes it to the next available row: Last Row Paste to different Worksheet VBA

I used the "dim lRow As Long" and removed the references to j and just tried to make it 

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

but that doesn't seem to work. Does anybody have an insight? I want to keep it as simple as possible.

AstralOmega
  • 11
  • 1
  • 1
    You also need to actually figure out what the last row is. [This question](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) explains how to. – BigBen Aug 21 '19 at 02:06
  • Have you seen [THIS](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) This doesn't use loops... – Siddharth Rout Aug 21 '19 at 04:59

1 Answers1

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
urdearboy
  • 14,439
  • 5
  • 28
  • 58