how much fasteris this?

Option Explicit
Sub Example()
    Dim rngName As Range
    Dim rngPrior As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set rngName = Range("A6:A15000").Find("Name")
    
    If rngName Is Nothing Then
        MsgBox "No cells in column A that contain ""Name"""
        Exit Sub
    End If
    
    Set rngPrior = rngName
    
    While Not rngName Is Nothing
        
        If rngName.Row < rngPrior.Row Then Exit Sub
        
        With Sheet1.Range(rngName.Offset(1, 7), rngName.Offset(1, 10))
            .Resize(rngName.CurrentRegion.Rows.Count - 3).Value = .Value
        End With
        
        Set rngPrior = rngName
        Set rngName = Range("A6:A15000").Find("Name", rngName)
    
    Wend
    
    Set rngPrior = Nothing
    Set rngName = Nothing
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic

End Sub