繰り返しコピー

Dim Row As Integer
For Row = 57 To 114
    If Range("AI" & Row).Value <> "" Then
        Range("AI" & Row).Select
        Selection.Copy
        Range("E" & Row).Select
        ActiveSheet.Paste
    End If
Next Row
Sub group8()

' データ消去
Dim resultRow, resultMaxRow As Integer
Worksheets("result").Select
If Range("B5").Value <> "" Then
    resultMaxRow = Range("B5").End(xlDown).Row
    Range("B5", Cells(resultMaxRow, "G")).Clear
End If


' 転記処理
Dim myRow, myCol, i, j As Integer

Worksheets("marged").Select
maxRow = Range("b5").End(xlDown).Row
j = 5

For i = 1 To 8
    For myRow = 5 To maxRow
        If Range("G" & myRow).Value = i Then
            Range(Cells(myRow, "B"), Cells(myRow, "E")).Select
            Selection.Copy
            Worksheets("result").Range("B" & j).PasteSpecial
            Worksheets("result").Range("F" & j).Value = i
            j = j + 1
        End If
    Next myRow
Next i


End Sub

VBA をもっとサラサラと書けるようになりたいわん。