Uma possibilidade

Sub Pesquisa()
Dim lastRow As Long, lastResultRow As Long, X As Long
Dim Km As Long, Litros As Long
        
' Verifica qual a ultima célula preenchida
lastRow = Folha1.Cells(Rows.Count, 1).End(xlUp).Row
        
' Apaga valores anteriores
Folha2.Range("A2:f500").ClearContents
        
lastResultRow = 2 'linha resultado
        
' Ciclo em todas as linhas
For X = 2 To lastRow '1 Linha dados pequisa
        
    ' verifica se o valor é igual ao da pesquisa
    If Folha1.Cells(X, 1).Value = TextBox1.Text Then '1 coluna pequisa
        Km = Km + Folha1.Cells(X, 2).Value
        Litros = Litros + Folha1.Cells(X, 3).Value
    End If
Next
    Sheets("Folha2").Range("A" & lastResultRow) = TextBox1.Text
    Sheets("Folha2").Range("B" & lastResultRow) = Km
    Sheets("Folha2").Range("C" & lastResultRow) = Litros
    lastResultRow = lastResultRow + 1
End Sub

Boa tarde,
É isso mesmo, funcionou na perfeição!!
Obrigado