Lignes doubles sur vba

Sub Macro1()
Dim Z As Range
Dim c As Range
Application.ScreenUpdating = False
Set Z = Range("A1:A" & [A65536].End(xlUp).Row)
For Each c In Z
If c.Row Mod 2 = 0 Then
c.EntireRow.Insert
End If
Next
For Each c In Z
If IsEmpty(c) Then
  c = c.Offset(1, 0)
  End If
Next
Application.ScreenUpdating = True
End Sub

Option Explicit
Sub test()
Dim t() As Variant, i As Integer, j As Byte, k As Integer
t = Range("A1:C" & Range("C65536").End(xlUp).Row).Value
For i = LBound(t, 1) To UBound(t, 1)
    For j = 0 To 1
        Range(Cells(k + 1, 1), Cells(k + 1, 3)).Value = Array(t(i, 1), t(i, 2), t(i, 3))
        k = k + 1
    Next j
Next i
End Sub