Duplicare elenco verticale in orizzontale

Option Explicit
Sub Orriz()
Dim Ur, R, X, Y, C
Ur = Range("A" & Rows.Count).End(xlUp).Row
For X = 4 To Ur
    If Cells(X, 3) = "CELIBE" Then
        C = 13
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) <> 0 Then
            For Y = 0 To Cells(X, 4)
                Range(Cells(X, 6 + C), Cells(X, 7 + C)).Copy
                Cells(X, 6 + C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
    ElseIf Cells(X, 3) = "SEPARATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) > 0 Then
            C = 13
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
            X = X + Y
        End If
    ElseIf Cells(X, 3) = "CONIUGATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Range(Cells(X, 6), Cells(X, 7)).Copy
        Cells(X, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) > 0 Then
            C = 13
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
            X = X + Y
        End If
    End If
Next X
End Sub