Copy/Drag Down for Data range's running extremely slow.

Hey, I'm trying to get this macro below working faster but it's going incredibly slow for a reason I don't know...

    Dim rngName As Range: 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
    Dim rngPrior As Range: Set rngPrior = rngName
    
    While Not rngName Is Nothing
        If rngName.Row < rngPrior.Row Then Exit Sub
        rngName.Offset(1, 130).Copy rngName.Offset(1, 130).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 131).Copy rngName.Offset(1, 131).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 132).Copy rngName.Offset(1, 132).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 133).Copy rngName.Offset(1, 133).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 134).Copy rngName.Offset(1, 134).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 135).Copy rngName.Offset(1, 135).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 141).Copy rngName.Offset(1, 141).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 142).Copy rngName.Offset(1, 142).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 143).Copy rngName.Offset(1, 143).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 144).Copy rngName.Offset(1, 144).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 145).Copy rngName.Offset(1, 145).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 160).Copy rngName.Offset(1, 160).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 161).Copy rngName.Offset(1, 161).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 162).Copy rngName.Offset(1, 162).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 163).Copy rngName.Offset(1, 163).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 164).Copy rngName.Offset(1, 164).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 165).Copy rngName.Offset(1, 165).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 161).Copy rngName.Offset(1, 171).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 162).Copy rngName.Offset(1, 172).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 173).Copy rngName.Offset(1, 173).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 174).Copy rngName.Offset(1, 174).Resize(rngName.CurrentRegion.Rows.Count - 3)
        rngName.Offset(1, 175).Copy rngName.Offset(1, 175).Resize(rngName.CurrentRegion.Rows.Count - 3)
        Set rngPrior = rngName
        Set rngName = Range("A6:A15000").Find("Name", rngName)
    Wend

Hi Hyflex

Gotta be a better way , what are you doing?

Hi Hyflex
Maybe something like...

Sub Example()
    
    Dim rngName As Range: 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
    Dim rngPrior As Range: Set rngPrior = rngName
    
    While Not rngName Is Nothing
        If rngName.Row < rngPrior.Row Then Exit Sub
       Range(rngName.Offset(1, 7), rngName.Offset(1, 10)).Copy rngName.Offset(1, 7).Resize(rngName.CurrentRegion.Rows.Count - 3)
      '  rngName.Offset(1, 8).Copy rngName.Offset(1, 8).Resize(rngName.CurrentRegion.Rows.Count - 3)
       ' rngName.Offset(1, 9).Copy rngName.Offset(1, 9).Resize(rngName.CurrentRegion.Rows.Count - 3)
       ' rngName.Offset(1, 10).Copy rngName.Offset(1, 10).Resize(rngName.CurrentRegion.Rows.Count - 3)
        Set rngPrior = rngName
        Set rngName = Range("A6:A15000").Find("Name", rngName)
    Wend
    
End Sub

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