Another:

Sub lacticacidbath()
Application.ScreenUpdating = False
Range("B2").Select
Do Until ActiveCell.Value = ""
    If ActiveCell.Value = ActiveCell.Offset(1).Value Then
        Range(ActiveCell.Offset(, 1), ActiveCell.Offset(, 7)).Copy ActiveCell.Offset(1, 1)
    End If
    ActiveCell.Offset(1).Select
Loop
Application.ScreenUpdating = True
End Sub