Sub MyDateAdd()
       Dim Sh, FUN As Object
    Dim MyRange As Range
    Dim MyCol, FirstRow, i, MaxDays, MyMonth, MyYear As Long
    Dim TempDate As Date
         Set FUN = Application.WorksheetFunction
     Set MyRange = Application.InputBox("Выделите таблицу для обработки польностью", Type:=8)
    Set Sh = MyRange.Parent
     FirstRow = MyRange.Row + 1
    MyCol = MyRange.Column
    MyMonth = Month(Sh.Cells(FirstRow, MyCol).Value)
    MyYear = Year(Sh.Cells(FirstRow, MyCol).Value)
       MaxDays = Day(FUN.EoMonth(FUN.Max(MyRange.Columns(1)), 0))
        Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
        i = 1
       Do While i <= MaxDays
             TempDate = DateSerial(MyYear, MyMonth, i)
               If Sh.Cells(i + 1, MyCol).Value <> TempDate Then
            Sh.Rows(i + 1).Insert
                   Sh.Cells(i + 1, MyCol).Value = TempDate
                      i = i + 1
        Else
                    i = i + 1
        End If
    Loop
    
        Sh.Range(Sh.Cells(FirstRow, MyCol + 1), Sh.Cells(FirstRow, MyRange.Columns.Count)).NumberFormat = "[h]:mm:ss"
     Sh.Range(Sh.Cells(FirstRow, MyCol), Sh.Cells(FirstRow, MyRange.Columns.Count)).Copy
    Sh.Range(Sh.Cells(FirstRow, MyCol), Sh.Cells(MaxDays + 1, MyRange.Columns.Count)).PasteSpecial xlPasteFormats
        Application.ScreenUpdating = True
       Application.Calculation = xlCalculationAutomatic
 End Sub