Sub Estrai() Dim ur As Long Dim rng As Range Dim cel As Range Set rng = Sheets("Foglio1").Range("X6:AB39") Sheets("Estrazione Dati").Range("A6:W1000").ClearContents For Each cel In rng ur = Sheets("Estrazione Dati").Cells(Rows.Count, 1).End(xlUp).Row If cel.Value = Sheets("Estrazione Dati").Range("B2").Value Then Sheets("Estrazione Dati").Cells(ur + 1, 1).Value = Sheets("Foglio1").Cells(cel.Row, "a").Value Sheets("Estrazione Dati").Cells(ur + 1, 2).Value = Sheets("Foglio1").Cells(cel.Row, "b").Value Sheets("Estrazione Dati").Cells(ur + 1, 3).Value = Sheets("Foglio1").Cells(cel.Row, "c").Value End If Next cel End Sub