如果满足多个条件，则VBA复制数据 [英] VBA to copy data if multiple criteria are met

问题描述

我试图创建一个VBA代码，当满足第一列中的"Lukas"和第二列中的"Apple"的条件时，将以下选项卡第三列中的数据复制到工作表结果"中.我知道可以仅使用具有多个条件的VLOOKUP来完成此操作，但是数据源长度通常会发生变化，并且我需要宏才能从ROW 2进行检查，直到最后一个可见的ROW.

I am trying to create a VBA code which copies into Sheet "Results" the data in the third column of the below tab when the criteria "Lukas" in the first column and "Apple" in the second column are met. I know this could be done just using a VLOOKUP with multiple criteria but the data source length usually changes and I need the macro to do the check from ROW 2 until the last visible ROW.

根据我的示例，运行宏后，我应该在第二张表中找到值8和5.下面是我一直在编写的代码，但是无法正常工作.

According to my example, I should find the values 8 and 5 in the second sheet after running the macro. Below is the code I have been writing which is not working however..

    Sub copy()

Dim LastRow As Long
Dim i As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If Worksheets("Sheet1").Cells(i, 1) = "Lukas" And Worksheets("Sheet1").Cells(i, 2) = "Apple" Then
 Worksheets("Sheet1").Cells(i, 3).Select
 Selection.copy
 Sheets("Sheet2").Select
 Range(Cells(1, 1)).PasteSpecial xlPasteValues

End If
Next i

End Sub

推荐答案

不要调用子过程Copy().称其为"其他".

Don't call your sub procedure Copy(). Call it anything else.

选择其他目的地，否则您将覆盖要传输的值.

Choose a different destination or you are just going to overwrite the values you are transferring across.

Sub copyLukasAndApple()

    Dim LastRow As Long, i As Long, ws2 as worksheet

    with Worksheets("Sheet1")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To LastRow

            If .Cells(i, 1) = "Lukas" And .Cells(i, 2) = "Apple" Then
                with workSheets("Sheet2")
                    .cells(.rows.count, "A").end(xlup).offset(1, 0) = _
                         Worksheets("Sheet1").Cells(i, 3).value
                end with
            End If

        Next i
    end with

End Sub

这篇关于如果满足多个条件，则VBA复制数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！