Inserting lines according to number of days, adjusting date
Made a mistake, this
Cells(Cref, 0).Select
should be
Cells(Cref, 1).Select
so..
Sub InsertRows()
Dim Startdate As Date
Dim EndDate As Date
Dim Gap
Dim Prow As Integer
Dim Cref As Integer
Sheets("Sheet1").Select
Range("A1").Select
Cref = 1
Do Until ActiveCell.Value = ""
Startdate = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
EndDate = ActiveCell.Value
Gap = EndDate - Startdate
For i = 0 To Gap
Let Prow = Prow + 1
Sheets("Sheet2").Cells(Prow, 1) = Startdate
Sheets("Sheet2").Cells(Prow, 2) = Startdate
Sheets("Sheet2").Cells(Prow, 3) = ActiveCell.Offset(0,
1).Value
Sheets("Sheet2").Cells(Prow, 4) = ActiveCell.Offset(0,
2).Value
Startdate = Startdate + 1
Next
Cref = Cref + 1
Cells(Cref, 1).Select
Loop
End Sub
|