[英]Copy Cells in One Column, Based on Criteria in Another Column, to Another Sheet
我需要根据另一列中的数据将一列中的条目复制到另一张工作表中。
我在 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
我在 Sheet2 上有以下数据
Column 1
A
B
C
D
我想检查工作表 1 的第 3 列中是否有值,并将第 1 列中的条目复制到工作表 2 中的第 1 列的底部。
我希望 Sheet 2 看起来像这样:
Column 1
A
B
C
D
"FROM SHEET 1"
L
O
L 和 O 出现是因为它们在工作表 1 的第 3 列中具有值。
我定义了两个工作表的底部行,并尝试通过设置范围 Column3A:lastrow 并评估第 3 列 <>"" 中的单元格是否进行评估。
该副本不起作用,我不确定它会按照我想要的方式粘贴。
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
我认为for each cell in r1
中的for each cell in r1
都没有找到正确的单元格。
我很快写了这个宏,考虑到你的数据格式,它似乎对我来说很好用
它只是将工作表 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
这可能不是到达最后一行的最优雅的方式,但它确实有效。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.