| |
こんな感じでしょーか ?
Sub Row_Ins()
Dim LR As Range, MyR1 As Range, MyR2 As Range
Dim i As Long, x As Long
Set LR = Range("A65536").End(xlUp).End(xlUp).Offset(-1)
Set MyR1 = Range("A2", LR).SpecialCells(2)
Set MyR2 = Range("A2", LR).SpecialCells(4)
Application.ScreenUpdating = False
For i = MyR1.Areas.Count To 1 Step -1
x = 9 - MyR1.Areas(i).Cells.Count
If x > 0 Then
MyR2.Areas(i).Resize(x).EntireRow.Insert xlShiftDown
End If
Next i
Set LR = Nothing: Set MyR1 = Nothing: Set MyR2 = Nothing
Application.ScreenUpdating = True
End Sub
|
|
