简体   繁体   中英

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

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.

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.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM