Find the String if Match then write to adjacent Columns

Sub Updatevalues()
    Dim lastrow As Long, rng As Range
    Dim lastrow2 As Long, rng2 As Range, cel As Range
    Application.ScreenUpdating = False
    With Sheet2
        lastrow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng2 = .Range("B2:B" & lastrow2)
    End With
    For Each cel In rng2
        With Sheet1
            .AutoFilterMode = False
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("B1:B" & lastrow)
            rng.AutoFilter Field:=1, Criteria1:=cel.Value & "*"
            On Error Resume Next
            rng.Offset(1, 2).SpecialCells(12).Value = cel.Offset(0, 1).Value
            rng.Offset(1, 3).SpecialCells(12).Value = cel.Offset(0, 2).Value
            rng.Offset(1, 4).SpecialCells(12).Value = cel.Offset(0, 3).Value & ""
            On Error GoTo 0
        End With
    Next cel
    With Sheet1
        .Cells(lastrow + 1, 4).Resize(1, 3).ClearContents
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

ShazSh