ho fato cosi

codice:
Sub CopiaRicerca()
Dim cerca As String
Dim foglio As Integer
Dim i, riga, ultimariga As Long
cerca = InputBox("seleziona il luogo rispettando maiuscole e minuscole")
Sheets("Sheet4").Cells.Clear
 For Sheet = 1 To Sheets.Count - 1
  ultimariga = Sheets(Sheet).Range("F" & Rows.Count).End(xlUp).Row
   For riga = 1 To ultimariga
    If Sheets(Sheet).Cells(riga, "F") = cerca Then
     i = i + 1
     Sheets(Sheet).Cells(riga, "F").EntireRow.Copy Destination:=Sheets("Sheet4").Cells(i, 1)
    End If
   Next
 Next
End Sub
e non funziona bene...
mi mette tutti quelli del foglio3 e il primo del foglio 2
ma non mette tutti