繰り返しコピー
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 をもっとサラサラと書けるようになりたいわん。