to fill the blank rows
Sub Macro3()
Dim i As Long, x As Long, dat As Date
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
x = Cells(i, "J").Value - 1
Rows(i + 1).Resize(x).Insert
Range(Cells(i + 1, "A"), Cells(i + 1, "D")).Resize(x).Value = Range(Cells(i, "A"), Cells(i, "D")).Value
Range(Cells(i + 1, "G"), Cells(i + 1, "L")).Resize(x).Value = Range(Cells(i, "G"), Cells(i, "L")).Value
Range("F" & i).ClearContents
Next i
lr = Range("B" & Rows.Count).End(xlUp).Row
For x = 2 To lr
If Range("E" & x) = vbNullString Then
If Month(Range("E" & x - 1)) < 12 Then
dat = "1/" & Month(Range("E" & x - 1)) + 1 & "/" & Year(Range("E" & x - 1))
Range("E" & x, "F" & x).Value = dat
End If
If Month(Range("E" & x - 1)) = 12 Then
dat = "1/01/" & Year(Range("E" & x - 1)) + 1
Range("E" & x, "F" & x) = dat
End If
End If
If Range("E" & x) <> vbNullString Then Range("F" & x).Value = Range("E" & x).Value
Next
End Sub
Kind regards
Leo
Bookmarks