パソコンの学習支援ブログ pcmanabu

Sub 千円以上()

    Worksheets("Sheet4").Select
    Range("D4").Select

    Worksheets("商品一覧").Select
    Range("D4").Select
    ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.Value = ""
        If ActiveCell.Value >= 1000 Then
            ActiveCell.EntireRow.Copy
            Worksheets("Sheet4").Select
            ActiveCell.EntireRow.Insert
            ActiveCell.Offset(1, 0).Select
            Worksheets("商品一覧").Select
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub