Auto add rows

I'm building a list of questions and these questions are compiled under about 10 different categories. what i am trying to do is have this list be adaptable so that if i want to add more questions in a catagory the catagory expands and adds a blank space below the last question in the category.
i also want to have each category on a separate sheet which adjusts when I work on the master sheet
example.xlsx
i attached an example sheet. not the whole thing just a few categories to see my structure.

thanks

Hello there,

Attached is a workbook I believe accomplishes what you are trying to achieve.

To run the macro, enable macros and then press Ctrl+w on your keyboard.

To insert the code into your workbook

1.Press Alt+F8 on your keyboard
2.Clear the macro name box and type CreateWorksheets in the blank box provided
3.Select the Create option
4.In between the Sub CreateWorksheets() and End Sub copy and paste the below code:

Dim c As Range, LR As String, x As Long, NxtLR As String
Dim ws As Worksheet, y As String

x = 2   'set x = 2

With Sheets(1)  'with the first worksheet in this workbook
    'find and replace with nothing the cells that the code places End Marker in
    .UsedRange.Replace What:="End Marker", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False

    LR = .Range("G6555").End(xlUp).Row + 1  'set LR equal to the first cell in column G that is blank
        If Cells(LR, 1).Value = vbNullString Then   'if the cell in column A of the row LR is blank then
            Cells(LR + 1, 7).Value = "End Marker"   'add the text End Marker to the LR row column G
            Cells(LR + 1, 1).Value = "End Marker"   'add the text End Marker to the LR row column A
            'added to reference the last category on the worksheet
        End If
     LR = .Range("G6555").End(xlUp).Row + 1  'set LR equal to the first cell in column G that is blank
     
        For Each c In .Range("A3:A" & LR).Cells 'for each cell in column A from row 3 to LR (defined above)
            If c.Value <> vbNullString Then 'if the value in the current cell in the loop is not nothing then
                
                'use SheetExists function defined below to check to see if the worksheet exists
                'whose name is the value of the cell in column A row x 'defined as 2 for the first loop
                'then redefined as the found cell's row at the end of the code
                If SheetExists(.Range("A" & x).Value) Then
                    'do nothing
                Else    'if the worksheet does not exits then
                    
                    'add the worksheet to the end of the workbook with the name
                    'equal to the value in column A row x
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = .Range("A" & x).Value
                
                End If
                    .Rows("1:1").Copy   'copy header row from all questions worksheet
                        With Sheets(.Range("A" & x).Value)  'with the worksheet whose name is equal to the value in column A row x
                            .Rows("1:1").PasteSpecial   'paste the header row into row 1
                        End With
                    
                    'copy the cells in columna A to I rows x to the current cell in the loop's row
                    .Range(.Cells(x, 1), .Cells(c.Row - 1, 9)).Copy
                    
                        With Sheets(.Range("A" & x).Value)  'with the worksheet whose name is equal to the value in column A row X
                            NxtLR = .Range("g6555").End(xlUp).Row + 1   'set NxtLr equal to the first empty cell in column G
                            .Range("A" & NxtLR).PasteSpecial    'paste the copied data here
                            
                            'the below line removes duplicated information
                            'because adds all entries, I added the remove duplicate line so that cateory entries wouldn't be duplicated
                            .UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
                            , 8, 9), Header:=xlYes
                            .UsedRange.Columns.AutoFit  'autofit columns
                            .UsedRange.Rows.AutoFit 'autofit rows
                            .Columns("F").ColumnWidth = 11.29   'set column F width to 11.29
                        End With
                x = c.Row   'reset x to the current cell in the loop's row

            End If
        Next c  'move to next cell in the loop
.Select 'select the first worksheet
End With

Below the End Sub copy and paste the below code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''function compliments of http://www.mrexcel.com/forum/showthread.php?58374-VBA-find-sheet-name''''
Function SheetExists(strWSName As String) As Boolean
    Dim ws As Worksheet 'declare variable
    On Error Resume Next    'on error move to next line
    Set ws = Worksheets(strWSName)  '
    If Not ws Is Nothing Then SheetExists = True
End Function

Anything that appears in green is a comment I left to help you understand the code.

5.Exit out of the Visual Basic Window
6.Press Alt+F8 again and this time select the CreateWorksheets macro
7.Select Run
8. To assign the Ctrl+w to the macro, press Alt+F8 and select the CreateWorksheets macro
then select Option. In the space provided assign a shortcut key.

Let me know how these work for you!