Hi
there might be a better solution. In the meantime try this.
Code:Sub kTest() Dim d As Date, ed As Date Dim r As Range, c As Range Dim i As Long Set r = Range("d" & Rows.Count).End(xlUp) d = CDate(r.Value2) ed = DateSerial(Year(d), Month(d) + 1, 1) - 1 For i = r.Row To 1 Step -1 Set c = Cells(i, r.Column) d = CDate(c.Value2) If ed - d > 1 Then c.Offset(1).Resize(Day(ed) - Day(d) - 1).EntireRow.Insert c.AutoFill c.Resize(Day(ed) - Day(d) + 1) End If ed = CDate(d) Next If Day(ed) > 1 Then c.Resize(Day(ed) - 1).EntireRow.Insert Cells(1, r.Column) = DateSerial(Year(ed), Month(ed), 1) Cells(1, r.Column).AutoFill Cells(1, r.Column).Resize(Day(ed)) End If End Sub




Reply With Quote
Bookmarks