Question

VBA初学者在这里。我需要根据另一列的数据将列中的条目复制并粘贴到另一个工作表。我在Sheet 1上有以下数据

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

我在另一张表（表2）上有以下数据

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列中的单元格是否评估＆＃34;＆＃34;但副本似乎不起作用，我不确定它会粘贴我想要的东西。非常感谢提前。

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

我认为我的问题是，对于r1中的每个单元格，这似乎并没有找到正确的单元格 - 任何建议？

Answer 1

我很快写了这个宏，考虑到你的数据格式，它似乎对我来说很好。

它只是将工作表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

它可能不是最优雅的方式来到最后一排，但它确实有效。

VBA宏 - 如何根据另一列中的条件复制单个列中的单元格并粘贴到另一个列中

1 个答案: