Crear lista y colocar formula en celdas diferentes

Buen dia, espero se encuentren bien, el motivo de mi petición es para ver si es posible ayudarme con lo siguiente,

Hice una macro para automatizar la creacion de un archivo de trabajo, que al final deberia quedar como el archivo muestra que anexo, sin embargo no logro crear el data list en la sheet2 de acuerdo a la cantidad de preguntas ingresada, asi mismo tampoco puedo formular el count de acuerdo a la cantidad de preguntas ingresadas.

Les anexo el codigo y el ejemplo de como debe quedar, la cantidad de preguntas, dias y metodo de evaluacion son diferentes

Espero haberme explicado :/

Sub Iniciar()


Dim j As Integer

Dim dia As String

Dim Preguntas As Integer

Dim Encuestas As Integer



Cells.Select

    Selection.ClearContents

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


Range("B7").Select

    ActiveCell.FormulaR1C1 = "5"

    Range("B8").Select

    ActiveCell.FormulaR1C1 = "4"

    Range("B9").Select

    ActiveCell.FormulaR1C1 = "3"

    Range("B10").Select

    ActiveCell.FormulaR1C1 = "2"

    Range("B11").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("B12").Select

    ActiveSheet.Next.Select

    Range("B3").Select

    ActiveCell.FormulaR1C1 = "5"

    Range("C3").Select

    ActiveCell.FormulaR1C1 = "4"

    Range("D3").Select

    ActiveCell.FormulaR1C1 = "3"

    Range("E3").Select

    ActiveCell.FormulaR1C1 = "2"

    Range("F3").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("G3").Select


    Columns("B:FB").Select

    With Selection.Validation

        .Delete

        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _

        :=xlBetween

        .IgnoreBlank = True

        .InCellDropdown = True

        .InputTitle = ""

        .ErrorTitle = ""

        .InputMessage = ""

        .ErrorMessage = ""

        .ShowInput = True

        .ShowError = True

    End With


    Range("A1").Select

               Selection.End(xlUp).Select

           Selection.End(xlUp).Select

           Selection.End(xlUp).Select

           Selection.End(xlUp).Select

           Selection.End(xlUp).Select

    Selection.End(xlToLeft).Select

    Selection.End(xlToLeft).Select

    Selection.End(xlToLeft).Select

    Selection.End(xlToLeft).Select

    Selection.End(xlToLeft).Select




Worksheets("Concentrado").Select


Encuestas = Application.InputBox("Cuantas encuestas son?", "Escribe el número en la caja", , 250, 75, "", , 1)


For i = 0 To Encuestas


    Worksheets("Total Encuestas").Select

          ActiveCell.Offset(0, 1).Range("A1").Select


    ncues = i + 1


    ActiveCell.Range("A1").FormulaR1C1 = "Encuesta" & ncues



Next i

    ActiveCell.FormulaR1C1 = ""


    MsgBox "Se ingresaron las encuestas"


    ActiveSheet.Next.Select

    Selection.End(xlUp).Select

    Selection.End(xlToLeft).Select


Worksheets("Concentrado").Select


    Worksheets("Concentrado").Select

Range("B2").Value = Trim(InputBox("Introduce Titulo de Encuestas"))


Range("B3").Value = "Total de Encuestas:"

Range("B5").Value = Trim(InputBox("Introduce la pregunta NPS"))



Range("B13").Select

Worksheets("Total Encuestas").Select

        Range("A4").Select

Worksheets("Concentrado").Select



A:


dia = Application.InputBox("Qué día o nombre es?", "Escribe el día en la caja", , 250, 75, "", , 0)

ActiveCell.FormulaR1C1 = dia

ActiveCell.Offset(1, 0).Select

With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With


Preguntas = Application.InputBox("Cuantas preguntas tiene?", "Escribe el número en la caja", , 250, 75, "", , 1)


modeval = Application.InputBox("Que tipo de Evaluacion es?", "1 1-10,2 1-5,3 text Ing,4 Text Ing2,5 Text Spa", , 250, 75, "", , 1)


    If modeval = 1 Then

     ActiveCell.Offset(0, 1).Select


ActiveCell.FormulaR1C1 = 10

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 9

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 8

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 7

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 6

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 5

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 4

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 3

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 2

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 1


ActiveCell.Offset(0, -10).Select


    End If

If modeval = 2 Then

     ActiveCell.Offset(0, 1).Select


ActiveCell.FormulaR1C1 = 5

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 4

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 3

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 2

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = 1


ActiveCell.Offset(0, -5).Select


    End If

If modeval = 3 Then

     ActiveCell.Offset(0, 1).Select


ActiveCell.FormulaR1C1 = "Very Good"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Good"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Barely Acceptable"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Poor"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Very poor"


ActiveCell.Offset(0, -5).Select


Else


End If


If modeval = 4 Then

     ActiveCell.Offset(0, 1).Select


ActiveCell.FormulaR1C1 = "Strongly Agree"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Agree"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Disagree"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Strongly Disagree"


ActiveCell.Offset(0, -4).Select


Else

End If


If modeval = 5 Then

     ActiveCell.Offset(0, 1).Select


ActiveCell.FormulaR1C1 = "Muy bien"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Bien"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Regular"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Malo"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "No aplica"

ActiveCell.Offset(0, -5).Select


Else

End If



For i = 0 To Preguntas


ActiveCell.Offset(1, 0).Select


    Ortega = i + 1


    ActiveCell.FormulaR1C1 = "Pregunta " & Ortega


Next i

    ActiveCell.FormulaR1C1 = ""


    'inicia la preparacion de la hoja de encuestas


 Worksheets("Total Encuestas").Select

      ActiveCell.FormulaR1C1 = dia

     ActiveCell.Offset(1, 0).Select

With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False


    End With


For i = 0 To Preguntas


ActiveCell.Offset(1, 0).Select


    Ortega = i + 1


    ActiveCell.FormulaR1C1 = "Pregunta " & Ortega


Next i

    ActiveCell.FormulaR1C1 = ""




  Worksheets("Concentrado").Select


    'envia mensaje de ingreso correcto


    MsgBox "Se ingresaron las preguntas"


    MasPreguntas = Application.InputBox("Quieres ingresar otro día?", "1 = Si, 0 = No", , 250, 75, "", , 1)

    If MasPreguntas = 1 Then

        Selection.End(xlDown).Select

        Selection.End(xlDown).Select

        Selection.End(xlDown).Select

        Selection.End(xlUp).Select

        ActiveCell.Offset(2, 0).Select

        GoTo A:

    Else

    End If





End Sub [/Code]

ejemplo.zip