Sub Test()
'
Dim DataDate As Date
Dim DataFormulaColumnNumber As Long, DataFormulaStartColumnNumber As Long
Dim DataLastRowColumnB As Long
Dim DataRow As Long
Dim DataStartRowOfData As Long
Dim DateRow As Long
Dim LastRowExtract As Long
Dim MaxRowsToAdd As Long
Dim NextParticularRow As Long
Dim DaysToAdd As Long, MonthsToAdd As Long, WeeksToAdd As Long
Dim NextRowExtract As Long
Dim LastColumnNumberInDataSheetRow As Long
Dim DataDateColumn As String
Dim DataFormulaStartColumn As String, DataFormulaColumn As String
Dim DataNumberOfRowsColumn As String
Dim LastColumnInDataSheetRow As String
Dim ExtractAmountColumn As String, ExtractDateColumn As String
Dim LastColumnInDataRow As String, LastColumnInDataSheet As String
Dim wsData As Worksheet, wsExtract As Worksheet
'
DataDateColumn = "B" ' <-- Set this to the DateColumn of sheet 'Data'
DataFormulaStartColumn = "K" ' <-- Set this to the column letter where the formulas start
DataNumberOfRowsColumn = "G" ' <-- Set this to the 'Number of Rows' column letter
DataStartRowOfData = 2 ' <-- Set this to start row of data on the 'Data' sheet
ExtractAmountColumn = "D" ' <-- Set this to the AmountColumn letter on sheet 'Extract'
ExtractDateColumn = "B" ' <-- Set this to the DateColumn of sheet 'Extract'
MaxRowsToAdd = 365 ' <-- Set this to the maximum # of rows that will need to be added
'
DataFormulaStartColumnNumber = Range(DataFormulaStartColumn & 1).Column ' Convert DataFormulaStartColumn to a number
'
Set wsData = Sheets("Data")
Set wsExtract = Sheets("Extract")
'
With wsData
LastColumnNumberInDataSheetRow = .Cells(DataStartRowOfData, .Columns.Count).End(xlToLeft).Column ' Get last column number used in the 'Data' sheet DataRow
'
If LastColumnNumberInDataSheetRow >= DataFormulaStartColumnNumber Then ' If previous formulas exist on the 'Data' sheet then ...
.Range(.Cells(DataStartRowOfData, DataFormulaStartColumnNumber), _
.Cells(MaxRowsToAdd + DataStartRowOfData - 1, LastColumnNumberInDataSheetRow)).ClearContents ' Erase the previous formulas
End If
'
DataLastRowColumnB = .Range(DataDateColumn & .Rows.Count).End(xlUp).Row ' Get last row used in DataDateColumn of 'Data' sheet
'
DataRow = DataStartRowOfData - 1 ' Initialize DataRow
'
For DataFormulaColumnNumber = DataFormulaStartColumnNumber To _
DataFormulaStartColumnNumber + DataLastRowColumnB - DataStartRowOfData ' Loop through columns of the columns to place the formulas
DataRow = DataRow + 1 ' Increment DataRow
'
DataFormulaColumn = Split(Cells(1, DataFormulaColumnNumber).Address, "$")(1) ' Convert DataFormulaColumnNumber to DataFormulaColumn
'
.Range(DataFormulaColumn & DataStartRowOfData & ":" & DataFormulaColumn & _
.Range(DataNumberOfRowsColumn & DataRow).Value + 1) = "=IFERROR(MROUND(RANDBETWEEN(INDEX($D$1:$D$" & _
DataLastRowColumnB & "," & DataFormulaColumn & "$1),INDEX($E$1:$E$" & DataLastRowColumnB & _
"," & DataFormulaColumn & "$1)),INDEX($F$1:$F$" & _
DataLastRowColumnB & "," & DataFormulaColumn & "$1)),"""")" ' Formula to place into each formula column of 'Data' sheet
Next ' Loop back
'
LastColumnNumberInDataSheetRow = .Cells(DataStartRowOfData, .Columns.Count).End(xlToLeft).Column ' Get last column number used in the 'Data' sheet DataRow
'
LastColumnInDataSheetRow = Split(Cells(.Cells(DataStartRowOfData, Columns.Count).End(xlToLeft).Column).Address, "$")(1) '
'
.Range(DataFormulaStartColumn & DataStartRowOfData & ":" & LastColumnInDataSheetRow & _
MaxRowsToAdd + DataStartRowOfData - 1).Copy ' Copy formula range into memory (Clipboard)
.Range(DataFormulaStartColumn & DataStartRowOfData & ":" & _
LastColumnInDataSheetRow & MaxRowsToAdd + DataStartRowOfData - 1).PasteSpecial xlPasteValues ' Paste just the values back to range
Application.CutCopyMode = False ' Clear clipboard & 'marching ants' around copied range
End With
'
LastColumnInDataSheet = Split(Cells(wsData.Cells.Find("*", , xlFormulas, , xlByColumns, _
xlPrevious).Column).Address, "$")(1) ' Get updated LastColumnInDataSheet after all formulas added
'
With wsData.Range(DataFormulaStartColumn & DataStartRowOfData & ":" & _
LastColumnInDataSheet & MaxRowsToAdd + DataStartRowOfData - 1) ' Format the range of formulas added to the 'Data' sheet
.NumberFormat = "0.00"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.ReadingOrder = xlLTR
End With
'
'---------------------------------------------------------------------------------------------------------------------------
'
With wsExtract
LastRowExtract = .Range(ExtractAmountColumn & .Rows.Count).End(xlUp).Row ' Get last row used in ExtractAmountColumn of sheet 'Extract'
'
If LastRowExtract > 1 Then ' If there are previous results then ...
.Range("A2:" & ExtractAmountColumn & LastRowExtract).ClearContents ' Clear contents of previous results in sheet 'Extract'
End If
'
NextRowExtract = .Range(ExtractAmountColumn & .Rows.Count).End(xlUp).Row + 1 ' Get updated row # to start displaying data to
End With
'
DataRow = DataStartRowOfData - 1 ' Initialize DataRow
'
For DataFormulaColumnNumber = DataFormulaStartColumnNumber To DataFormulaStartColumnNumber + _
DataLastRowColumnB - DataStartRowOfData ' Loop through DataFormulaColumnNumbers
DataRow = DataRow + 1 ' Increment DataRow
'
DataFormulaColumn = Split(Cells(1, DataFormulaColumnNumber).Address, "$")(1) ' Convert DataFormulaColumnNumber to DataFormulaColumn
'
With Sheets("Data")
.Range(DataFormulaColumn & DataStartRowOfData & ":" & DataFormulaColumn & .Range(DataFormulaColumn & _
.Rows.Count).End(xlUp).Row).Copy wsExtract.Range(ExtractAmountColumn & NextRowExtract) ' Write Formula values to ExtractAmountColumn
'
LastRowExtract = wsExtract.Range(ExtractAmountColumn & wsExtract.Rows.Count).End(xlUp).Row ' Get last row used in ExtractAmountColumn of sheet 'Extract'
NextParticularRow = wsExtract.Range("C" & wsExtract.Rows.Count).End(xlUp).Row + 1 '
wsExtract.Range("C" & NextParticularRow & ":C" & LastRowExtract) = .Range("C" & DataRow) ' Copy particular to "Particular' column on sheet 'Extract'
'
DataDate = .Range(DataDateColumn & DataRow) ' Set DataDate = the date for the range
DateRow = NextParticularRow - 1 '
'
Select Case .Range(DataNumberOfRowsColumn & DataRow)
Case Is = 1: wsExtract.Range(ExtractDateColumn & DateRow + 1) = DataDate ' If DataNumberOfRowsColumn value = 1 then just write date
Case Is = 12 ' If DataNumberOfRowsColumn value = 12 then ...
For MonthsToAdd = 0 To 11 ' Loop through # of Months to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("m", MonthsToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
Case Is = 24 ' If DataNumberOfRowsColumn value = 24 then ...
For MonthsToAdd = 0 To 11 ' Loop through # of Months to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("m", MonthsToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
'
DataDate = DateAdd("d", 15, DataDate) ' Add 15 days to the DataDate
'
For MonthsToAdd = 0 To 11 ' Loop through # of Months to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("m", MonthsToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
Case Is = 52 ' If DataNumberOfRowsColumn value = 52 then ...
For WeeksToAdd = 0 To 51 ' Loop through # of Weeks to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("ww", WeeksToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
'
Case Is = 104 ' If DataNumberOfRowsColumn value = 104 then ...
For WeeksToAdd = 0 To 51 ' Loop through # of Weeks to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("ww", WeeksToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
'
DataDate = DateAdd("d", 4, DataDate) ' Add 4 days to the DataDate
'
For WeeksToAdd = 0 To 51 ' Loop through # of Weeks to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("ww", WeeksToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
'
Case Is = 365 ' If DataNumberOfRowsColumn value = 365 then ...
For DaysToAdd = 0 To 364 ' Loop through # of Days to add
DateRow = DateRow + 1 ' Increment DateRow
wsExtract.Range(ExtractDateColumn & DateRow) = DateAdd("d", DaysToAdd, DataDate) ' Write result to ExtractDateColumn
Next ' Loop back
End Select
End With
'
NextRowExtract = wsExtract.Range(ExtractAmountColumn & wsExtract.Rows.Count).End(xlUp).Row + 1 ' Get updated row # to start displaying data to
Next
'
With wsExtract.Range("A" & DataStartRowOfData & ":A" & NextRowExtract - 1)
.Value = wsExtract.Evaluate("Row(" & .Address & ") - " & DataStartRowOfData & "+ 1") ' Write the line #s to column A of sheet 'Extract'
End With
'
wsExtract.UsedRange.EntireColumn.AutoFit ' Autofit the widths of the columns on sheet 'Extract'
End Sub
OMG!! It is possible. You have understood it perfectly 
