VBA 代码帮助 - 需要为每个缺失的日期添加一行并从下面的单元格中复制数据

Question

I have the below code to add a line for each missing date then update column D with the missing date but I also want the new line to copy the data from the cells below for columns A to c and E to L.

Currently I end up with a worksheet like this

The VBA code is:

Dim wks As Worksheet
Set wks = Worksheets("NAV_REPORT")

Dim lastRow As Long
lastRow = Range("D2").End(xlDown).Row

For i = lastRow To 2 Step -1
    curcell = wks.Cells(i, 4).Value
    prevcell = wks.Cells(i - 1, 4).Value

    Do Until curcell - 1 <= prevcell
        wks.Rows(i).Insert xlShiftDown

        curcell = wks.Cells(i + 1, 4) - 1
        wks.Cells(i, 4).Value = curcell
    Loop
Next i

any suggestions for updating the above code to fill up from the cells below?

Thanks!

Answer 1

If you want the inserted row to be identical to the row above, all you need to do is to copy the row above and insert that like follows:

wks.Rows(i).Copy
wks.Rows(i).Insert xlShiftDown

This will insert the exact data on the previous row and the rest of your code will amend the date as necessary.

Answer 2

If I understand you correctly...

Sub test()
dim c as range: dim dif 
Set c = Range("D2")
Do Until c.Value = ""
    dif = DateDiff("d", c.Value, c.Offset(1, 0).Value)
    If dif > 1 Then
        With c.Offset(1, -3)
            .EntireRow.Copy
            Range(.Cells, .Offset(dif - 2, 0)).Insert Shift:=xlDown
        End With
        c.AutoFill Destination:=Range(c, c.Offset(dif - 1, 0)), Type:=xlFillDefault
        Set c = c.Offset(dif, 0)
    Else
        Set c = c.Offset(1, 0)
    End If
Loop
End Sub

The sub assumes that there is no blank cell in between the rows of data in column D.

the new line to copy the data from the cells below for columns A to c and E to L.

the "below" here is the yellow and orange before running the sub.

===>