Option Explicit Sub Copia_Record() Application.ScreenUpdating = False Dim NRg As Long, NCl As Long, x As Long, y As Long, z As Long Dim A As Byte, B As Byte Sheets("Foglio1").Select NRg = Range("B" & Rows.Count).End(xlUp).Row NCl = Cells(2, Columns.Count).End(xlToLeft).Column With Worksheets("Foglio2") Range(.Cells(2, 2), .Cells(NRg, NCl)).ClearContents z = 1 For x = 2 To NRg A = 0 B = 0 For y = 2 To NCl If Cells(x, y).Value = Cells(1, 1) Then A = 1 If Cells(x, y).Value = Cells(1, 2) Then B = 1 If A = 1 And B = 1 Then Range(Cells(x, 2), Cells(x, NCl)).Copy .Cells(z, 2) z = z + 1 Exit For End If Next y Next x End With Application.ScreenUpdating = True Cells(2, 2).Select End Sub
... With Worksheets("Foglio2") z = .Range("B" & .Rows.Count).End(xlUp).Row + 1 ...