Excel VBA Создание новых ячеек на основе данных ячейки

Question

поэтому я ищу, чтобы создать что-то, что создаст X количество ячеек, когда «X» будет введено в соответствующую ячейку, затем заполните эту ячейку цифрами, подсчитанными до X.

Поскольку я не могу вводить изображения, я создал приблизительный пример того, чего я пытаюсь достичь.

Как таблица будет начинаться

... | ........ ........ | ............ .B .................. .......... C ........

1. | ...... ............ | Введите данные ниже, чем. |

2. | Вопрос 1 | _______________ |

3. | Вопрос 2 | _______________ |

4. | Вопрос 3 | _______________ |

Ввод данных, ("Вопрос 1" не имеет никакого эффекта, но когда вопрос 2 "B3" вводится она будет создавать клетки)

... | ........ ........ | ............. B ............... | .......... C ........

1. | .................. | Введите данные ниже, чем. |

2. | Вопрос 1 | _____ Ответ ____ |

3. | Вопрос 2 | _______ 3 _______ | < ---------------

4. | Вопрос 3 | _______________ |

Тогда будет создано некоторое количество клеток базы на сумму вошли в "B3"

... | ........ ........ |. ............ B .................. .......... C ........

1. | .................. | Введите данные ниже, чем. |

2. | Вопрос 1 | _____ Ответ ____ |

3. | Вопрос 2 | _______ 3 _______ |

4. | Q1 .............. | _______________ | < ---------------

5. | Q2 .............. | _______________ | < ---------------

6. | Q3 .............. | _______________ | < ---------------

7. | Вопрос 3 | _______________ |

Если кто-то может помочь, это было бы высоко оценено. Не стесняйтесь запрашивать дополнительную информацию.

Answer 1

Вставить это в модуль листа вы заинтересованы в:

Public InModif As Boolean 

Private Sub Worksheet_Change(ByVal Target As Range) 

If InModif = True Then Exit Sub 
Application.ScreenUpdating = False 
InModif = True 

Dim NbInsert As Integer 

If Target.Count > 1 Then Exit Sub 
If Not Application.Intersect(Target, Me.Columns(2)) Is Nothing Then 
    If IsNumeric(Target.Value) Then 
     NbInsert = CInt(Target.Value) 
     Do While NbInsert <> 0 
      Rows(Target.Offset(1, 0).Row).Insert Shift:=xlDown 
      Target.Offset(1, 0).Value = NbInsert 
      Target.Offset(1, -1).Value = "Q" & NbInsert 
      NbInsert = NbInsert - 1 
     Loop 
    Else 
    End If 
Else 
End If 

InModif = False 
Application.ScreenUpdating = True 

End Sub