VBA to copy data if multiple criteria are met

  • A+

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.

VBA to copy data if multiple criteria are met

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 


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 


:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: