Create new line then copy and paste row - excel

Question

Im trying to create an excel macro to select a range of cells then insert new row every other row then copy and paste each row.
For example.
apples
oranges
mangos
My desired goal is
apples
apples
oranges
oranges
mangos
mangos
I have thousands of rows and a macro would be nice.
This Inserts a new row,every other row.
Sub InsertNewRows()
Dim rng As Range
Dim CountRow As Integer
Dim i As Integer
Set rng = Selection
CountRow = rng.EntireRow.Count
For i = 1 To CountRow
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(2, 0).Select
Next i
End Sub
How can I duplicate the lines in the range too?

Answer 1

Not inserting rows, this code copies and pastes each value twice. Inserting rows is really time consuming.
Here's a screenshot of before/after running code:
Sub test()
Dim MyData As Variant
Dim LR As Long
Dim i As Long
Dim Initial_Row As Long
LR = Range("A" & Rows.Count).End(xlUp).Row 'last non blank cell in column A
MyData = Range("A1:A" & LR).Value 'all data into array
Initial_Row = 1 'initial row where data starts pasting
For i = 1 To UBound(MyData) Step 1
Range("A" & Initial_Row & ":A" & Initial_Row + 1).Value = MyData(i, 1)
Initial_Row = Initial_Row + 2
Next i
Erase MyData 'delete data
End Sub

Answer 2

I recommend to read the values into an array and duplicate them into another array and finally write that array to the cells. This is much faster than duplicating cells.
Option Explicit
Public Sub DuplicateSelectedRows()
Dim SelRng As Range
Set SelRng = Selection
' read values into array
Dim SelectedValues As Variant
SelectedValues = SelRng.Value
' create output array of double the size
Dim DuplicatedValues As Variant
ReDim DuplicatedValues(1 To UBound(SelectedValues, 1) * 2, 1 To UBound(SelectedValues, 2))
' duplicate values
Dim iRow As Long
For iRow = 1 To UBound(SelectedValues, 1)
DuplicatedValues(iRow * 2 - 1, 1) = SelectedValues(iRow, 1)
DuplicatedValues(iRow * 2, 1) = SelectedValues(iRow, 1)
Next iRow
' output values
SelRng.Cells(1, 1).Resize(RowSize:=UBound(DuplicatedValues)).Value = DuplicatedValues
End Sub