□投稿者/ よねさん -(2020/01/15(Wed) 09:16:37)
| 2020/01/15(Wed) 12:19:06 編集(管理者)
2020/01/15(Wed) 11:45:20 編集(管理者)
こんな感じでしょうか?
ただし、このコードは1度だけしか実行してはいけません。
実行するたびに 挿入&コピーが増幅しますので、ご注意ください。
または、For i = lastRow To 2 Step -1 の部分を実行するたびに適切な値に書き換えるとかの対処が必要です。
Sub test1()
Dim i As Long
Dim lastRow As Long, s_Row As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, 4).Value > 1 Then
s_Row = Cells(i, 4).Value - 1
Range("A" & i + 1 & ":A" & i + s_Row).EntireRow.Insert
Range("A" & i & ":F" & i).Copy Range("A" & i + 1 & ":F" & i + s_Row)
End If
Next i
End Sub
--------
複数回実行したもいいように、コードを実行して挿入&コピーをしたら
G列にコピーしたら”済“と入力するように改変しました。
G列に"済"が入力されていないと、挿入&コピー対象となります。
これでどうでしょう。
Sub test1()
Dim i As Long
Dim lastRow As Long, s_Row As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, 4).Value > 1 And Cells(i, 7).Value <> "済" Then
s_Row = Cells(i, 4).Value - 1
Range("A" & i + 1 & ":A" & i + s_Row).EntireRow.Insert
Range("G" & i).Value = "済"
Range("A" & i & ":G" & i).Copy Range("A" & i + 1 & ":G" & i + s_Row)
End If
Next i
End Sub
|
|
行追加とコピー
/ sora (20/01/14(Tue) 15:43) #13430 
上記ツリーを一括表示 / 上記ツリーをトピック表示