Sub qq()
    Dim i As Long, j As Long, x As Range, y As Range
    Set x = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    j = 1 'Для нечетных строк. Для четных j = 2
    For i = j To x.Count Step 2
        If y Is Nothing Then Set y = x.Cells(i) Else Set y = Union(y, x.Cells(i))
    Next
    [D:D].ClearContents: y.Copy [D1]
End Sub

Option Explicit

Sub Скопировать_в_чётные()
    Dim rSource As Range, rTarget As Range
    Set rSource = GetSourceRange()
    If rSource Is Nothing Then Exit Sub
    Set rTarget = GetTargetRange()
    If rTarget Is Nothing Then Exit Sub
    
    Dim pref As String
    pref = GetFormulaPrefix(rSource, rTarget)
    
    If rTarget.Rows.Count <= 2 * rSource.Rows.Count Then
        Set rTarget = rTarget.Resize(2 * rSource.Rows.Count)
    End If
    
    If Not Intersect(rSource, rTarget) Is Nothing Then Exit Sub
    
    Dim trr As Variant, yt As Long, ys As Long
    trr = rTarget.Formula
    For ys = 1 To rSource.Rows.Count
        yt = yt + 2
        trr(yt, 1) = "=" & pref & rSource.Cells(ys, 1).Address(0, 0, xlA1)
    Next
    
    Do
        yt = yt + 2
        If yt > rTarget.Rows.Count Then Exit Do
        rTarget.Cells(yt, 1).ClearContents
    Loop
    
    rTarget.Formula = trr
End Sub

Private Function GetSourceRange() As Range
    Dim rr As Range
    On Error Resume Next
    Set rr = Application.InputBox("Выберите диапазон-источник.", "Источник", "A1:A7", Type:=8)
    Set GetSourceRange = Intersect(rr, rr.Parent.UsedRange)
    On Error GoTo 0
End Function
Private Function GetTargetRange() As Range
    Dim rr As Range
    On Error Resume Next
    Set rr = Application.InputBox("Выберите диапазон-приёмник.", "Приёмник", "$C1:C14", Type:=8)
    Set GetTargetRange = Intersect(rr, rr.Parent.UsedRange)
    On Error GoTo 0
End Function

Private Function GetFormulaPrefix(rSource As Range, rTarget As Range) As String
    If rSource.Parent.Parent.Name = rTarget.Parent.Parent.Name Then
        If rSource.Parent.Name = rTarget.Parent.Name Then
            GetFormulaPrefix = ""
            Exit Function
        End If
        GetFormulaPrefix = "'" & rSource.Parent.Name & "'!"
        Exit Function
    End If
    GetFormulaPrefix = "'[" & rSource.Parent.Parent.Name & "]" & rSource.Parent.Name & "'!"
End Function