VBA: repeat a value a number of times - vba

Question

I have an input table in range A2: D6, I want each value in input range to be shown 4 times in output
range A8: D27
Below is the code it is copying only one value to the output range.
Could you please guide me on how to change this VBA code to get the desired result as shown in the below picture.
Sub RepeatData()
Dim Rng As Range
Dim lr As Integer
Dim C As Integer
Range(("A8"), Range("D10000")).ClearContents
lr = Range(("A1"), Range("A2").End(xlDown)).Count
C = 4
Dim InputRng As Range, OutRng As Range
Set InputRng = Range("A2", Range("d" & lr))
Set OutRng = Range("a8")
For Each Rng In InputRng.Rows
xValue = Rng.Range("A1", "a1").Value
xNum = 4 ' No. of times to repeat
OutRng.Resize(xNum, C).Value = xValue
Set OutRng = OutRng.Offset(xNum, 0)
Next
End Sub

Answer 1

I can see that you are looping through entire input rows, so I would propose a solution copying entire rows.
Sub RepeatData()
Dim inputWorksheet As Worksheet
Dim inputRange As Range
Dim outputRangeStart As Range
Dim rowToBeCopied As Range
Dim firstFreeRow As Range
Dim numberOfOutputRows As Integer
Dim outputRange As Range
' set all params
Set inputWorksheet = Sheet1
Set inputRange = inputWorksheet.Range("A2:D5")
Set outputRangeStart = inputWorksheet.Range("A8")
numberOfOutputRows = 4
' clean output range
Range(outputRangeStart, outputRangeStart.End(xlDown).End(xlToRight)).ClearContents
' copy values
For Each rowToBeCopied In inputRange.Rows
Set firstFreeRow = FindFirstFreeCell(outputRangeStart)
Set outputRange = ExtendRangeByNumberOfRows(firstFreeRow, numberOfOutputRows)
rowToBeCopied.Copy
outputRange.PasteSpecial xlPasteValues
Next rowToBeCopied
End Sub
Function FindFirstFreeCell(startFrom As Range) As Range
If IsEmpty(startFrom) Then
Set FindFirstFreeCell = startFrom
ElseIf IsEmpty(startFrom.Offset(1, 0)) Then
Set FindFirstFreeCell = startFrom.Offset(1, 0)
Else
Set FindFirstFreeCell = startFrom.End(xlDown).Offset(1, 0)
End If
End Function
Function ExtendRangeByNumberOfRows(rangeToBeExtended As Range, numberOfRows As Integer) As Range
Set ExtendRangeByNumberOfRows = Range(rangeToBeExtended, rangeToBeExtended.Offset(numberOfRows - 1, 0))
End Function