Add automatic rows with date

[ahmed elashkar]

Hello

I have a table with the following data

I want when I open the file Excel to check the date in the last row, if it less than today's date then adds rows automatically with dates until it reaches today's date and copy the function from the other cells to the cells in the new rows.

Would you please help me as i have no experience with VBA.

 

[HongRu]

Why not manually ?
Just to select the last row and drag down until today.

 

[ahmed elashkar]

Why not manually ?
Just to select the last row and drag down until today.

The sheet will run in the background catching the data from our machine's server, I don't want to rely on human to update it daily

 

[HongRu]

Try.

You should put the code in the ThisWorKbook of VBA.

Private Sub Workbook_Open()
    Call SbOpenCopy
End Sub

Sub SbOpenCopy()
    Dim S1 As Worksheet
    Set S1 = Worksheets("sheet1") 'Set the sheet
    
    Dim R1 As Range
    Set R1 = Range("A1")  'Set the Date column
    
    Dim R2 As Range
    Set R2 = Range("B1:D1") 'Set the columns to copy
    
    Dim R3 As Range
    Set R3 = R1.End(xlDown).End(xlDown).End(xlUp)
    
    Set R2 = R2.Offset(R3.Row - 1, 0)
    
    Dim myDay, myToday
    myDay = R3.Value
    myToday = Date
    
    Do Until myDay >= myToday
        i = i + 1
        R3.Offset(i, 0) = myDay + 1
        R2.Offset(i - 1, 0).Copy
        R2.Offset(i, 0).PasteSpecial
        myDay = myDay + 1
    Loop
End Sub

 

[ahmed elashkar]

Thank you much for your help, it worked perfectly

 

[anand3dinesh]

Private Sub Workbook_Open()

Dim Ldate As Range
Set Ldate = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)
Dim i As Double

If Ldate.Value <> Date Then

Do Until Ldate.Value = Date

Sheets("Sheet1").Range("A" & Ldate.Row + 1).Value = Ldate + 1
Set Ldate = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)

Loop

End If
End Sub