Copy Cells in One Column, Based on Criteria in Another Column, to Another Sheet

Question

I need to copy entries from a column based on data from another column to another sheet.

I have the following data on Sheet1

Column 1    Column 2    Column 3    Column 4 
J           1
K           2
L           3           X            W
M           4
N           5
O           6           Y            Z

I have the following data on Sheet2

Column 1
A
B
C
D

I want check if there is a value in Column 3 from Sheet 1 and copy the entry in Column 1 to the bottom of Column 1 from Sheet 2.

I want Sheet 2 to look like this:

Column 1
A
B
C
D
"FROM SHEET 1"
L
O

L and O appear because they have a value in Column 3 from Sheet 1.

I defined the bottom rows of both sheets and am trying to evaluate by setting a range Column3A:lastrow and evaluating if the cells in column 3 <>"".
The copy doesn't work and I'm not sure that it will paste how I want.

Dim rownum5 As Long, rownum6 As Long
rownum5 = Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Row
rownum6 = Sheets("Sheet1").Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row

With Sheets("Sheet1")
    Sheets("Sheet1").Activate
    Set r1 = Sheets("Sheet1").Range("E2:E" & rownum6)
    For Each cell In r1
        If cell.Value <> "" Then cell.Offset(0, -3).Copy
        .Paste Destination:=Sheets("Sheet2").Range("A" & rownum5 + 1)
    Next cell
End With

End Sub

I think the for each cell in r1 doesn't locate the right cells.

This can be done with in-cell formulas. You have a reason why you want this to happen via VBA? Also, what is the role of column 2 and 4, and the values in sheet 2 in light of the question? Could you not remove all that in the context of this question? — trincot
I do need this as a macro unfortunately, and yes the extra columns in Sheet 1 don't really matter in this case but that's exactly how it is on my sheet. For sheet 2 I just wanted to show it needed to go below existing data. — fordo19

ballsy26 ballsy26 · Accepted Answer · 2016-03-18T00:13:00

I quickly wrote this macro, it seems to be working fine for me given your data format

it just pastes the column 1 of sheet 1 to the end of column 1 in sheet 2

Sub main()

Dim LastRow As Long
Dim i As Integer
For i = 1 To 30
    If IsEmpty(Sheets("Sheet1").Cells(i, 3).Value) = False Then

    Sheets("Sheet2").UsedRange 'refreshes sheet2
    LastRow = Sheets("Sheet2").UsedRange.Rows(Sheets("Sheet2").UsedRange.Rows.Count).Row 'find the number of used rows

    Sheets("Sheet1").Cells(i, 3).Offset(0, -2).Copy Sheets("Sheet2").Range("A1").Offset(LastRow, 0) 'copies and pastes the data

Else
End If
Next i

End Sub

it's probably not the most elegant way to get to the last row but it does work.

Copy Cells in One Column, Based on Criteria in Another Column, to Another Sheet

1 Answers