简体   繁体   English

根据另一列中的条件将一列中的单元格复制到另一张工作表

[英]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我在 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我在 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.我想检查工作表 1 的第 3 列中是否有值,并将第 1 列中的条目复制到工作表 2 中的第 1 列的底部。

I want Sheet 2 to look like this:我希望 Sheet 2 看起来像这样:

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. L 和 O 出现是因为它们在工作表 1 的第 3 列中具有值。

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 <>"".我定义了两个工作表的底部行,并尝试通过设置范围 Column3A:lastrow 并评估第 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.我认为for each cell in r1中的for each cell in r1都没有找到正确的单元格。

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它只是将工作表 1 的第 1 列粘贴到工作表 2 中第 1 列的末尾

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.这可能不是到达最后一行的最优雅的方式,但它确实有效。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 根据列中的条件将行从一个工作表复制到另一个工作表 - Copy row from one sheet to another based on criteria in a column 根据另一个单元格中的条件将单元格从一个工作表复制到另一个工作表 - Copy cells from one sheet to another based on criteria in another cell 根据条件将单元格从特定列复制到另一个工作表 - Copy cells from a specific column to another worksheet based on criteria 通过“列”中的多个条件将数据从一张纸复制到另一张纸 - Copy data from one sheet to another by multiple criteria in the Column 如何根据列中的条件将行从一张纸复制到另一张纸-仅粘贴值和格式(不粘贴公式)? - How to copy rows from one sheet to another based on criteria in column— paste only values and formatting (not formulas)? 通过根据条件覆盖另一个工作表中的单元格来复制单元格和粘贴 - Copy cells and paste by overwriting cells in another sheet based on a criteria 想要根据一列中的值从一张纸复制到另一张纸 - Wanting to copy from one sheet to another, based on values in one column VBA代码可根据条件复制特定列中的单元格并将其粘贴(值)到另一张工作表中特定列中的单元格 - VBA code to copy cells in specific column and paste (value) it to cells in specific column on another Sheet based on conditions 根据条件将一列复制到另一列(MS Excel) - Copy one column to another based on a Criteria (MS Excel) VBA-根据多个条件从另一张纸复制单元格 - VBA - copy cells from another sheet based on multiple criteria
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM