VBA to copy data if multiple criteria are met

Question

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 \"Appl

Answer 1

This should do the trick:

Sub Selectivecopy()

Dim LastRow As Long
Dim i As Long
Dim j As Long

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

j = 1
For i = 2 To LastRow

If Worksheets("Sheet1").Cells(i, 1) = "Lukas" And Worksheets("Sheet1").Cells(i, 2) = "Apple" Then
     Worksheets("Sheet2").Cells(j,1) = worksheets("Sheet1").Cells(i,3).Value
     j = j +1
End If
Next i

End Sub

You can directly set the value of a cell, using this line: Worksheets("Sheet2").Cells(j,1) = worksheets("Sheet1").Cells(i,3).Value. Just increment jevery time you do so to paste the values below each other.

If you want this to continue under the last cell when you run your code a second time you will have to replace j = 1 with a lastrow approach for sheet 2 as well.

Also you use a lot of select and activesheets, it would be better to avoid that, for examples see: How to avoid using Select in Excel VBA , in your case you should use: Lastrow = Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row