Как вариант (раз уж сделал):
[vba]Код
Sub Варианты()
Dim sh As Object, i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name <> "Вопросы" Then sh.Delete
Next
Application.DisplayAlerts = True
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Sheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = "Вопрос " & i - 1
.[a3] = "Вопрос " & i - 1
Sheets("Вопросы").Range("C" & i & ":G" & i).Copy .[a5]
End With
Next i
Application.ScreenUpdating = True
End Sub
[/vba]