|
▼EBI さん:
下の部分を追加したら出来ると思います。
>Sub 年度経過削除()
> Dim BtNum As Integer
> BtNum = MsgBox("年度変更によりデータを削除します。", _
> vbOKCancel + vbExclamation, "年度更新")
> If BtNum = 2 Then Exit Sub
> Dim RR As Long, r1 As Range
Dim LastRow As Long
LastRow = Cells(21, 2).End(xlUp).Row 'B列の最終行を取得
> With ActiveSheet
> For RR = 4 To 20
If .Cells(RR, 2).Value < .Cells(2, 9).Value Then '←ここ変えました。
> On Error Resume Next
> Set r1 = .Rows(RR).SpecialCells(xlCellTypeConstants)
If RR = LastRow Then
r1.Copy
Cells(4, 2).PasteSpecial
Application.CutCopyMode = False
End If
> If Not r1 Is Nothing Then r1.ClearContents
> On Error GoTo 0
> Set r1 = Nothing
> End If
> Next
> End With
>
>End Sub
|
|