I need VBA that creates a new sheet for every data entered in column D

Function sheetexist(whatsheet)
On Error GoTo NotExists

ThisWorkbook.Worksheets(whatsheet).Select
sheetexist = True
Exit Function

NotExists:
sheetexist = False

End Function

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)
        If nret = False Then makesheet (whichsheet)
        nret = copyrowX(whichsheet, rowNum)
End Function

Sub makesheet(whatsheet)
On Error GoTo ExitSub
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = whatsheet
    End With

ExitSub:

End Sub


Function copyrowX(towhatsheet, whatrow)
        ThisWorkbook.Worksheets("Sheet1").Select
        ThisWorkbook.Worksheets("Sheet1").Range("A" & whatrow).EntireRow.Select
        Selection.Copy
        
        ThisWorkbook.Worksheets(towhatsheet).Select
        cellcount = Cells(ThisWorkbook.Worksheets(towhatsheet).Rows.Count, 1).End(xlUp).Row
        ThisWorkbook.Worksheets(towhatsheet).Range("A" & cellcount).EntireRow.Select
        Selection.Insert
        
End Function


Sub ReadSheet()
cellcount = Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
For RowCount = 1 To cellcount
    cellvalue = ThisWorkbook.Worksheets("Sheet1").Range("A" & RowCount).Value
    nret = testsheet(cellvalue, RowCount)
    ThisWorkbook.Worksheets("Sheet1").Select
Next
End Sub