Sub Font_Styles()
'Create a variable to store name which is mentioned in Inputbox
Dim Data As String
Data = Application.InputBox("Please enter your name", "www.Tricks12345.com")

'Number of worksheets in New workbook
Application.SheetsInNewWorkbook = 1

'Add New Workbook
Dim Wkb As Workbook
Set Wkb = Workbooks.Add

'Define a variable in for sheet in newly created workbook
Dim sh As Worksheet
Set sh = Wkb.Sheets("Sheet1")
Wkb.Activate

'Using FINDCONTROL method to define FONT
Dim Fonts
Set Fonts = Application.CommandBars("Formatting").FindControl(ID:=1728)

c = 1: r = 1

For i = 0 To Fonts.ListCount - 1
sh.Cells(r, c).Activate
sh.Cells(r, c).Value = Fonts.List(i + 1)
sh.Cells(r, c).Font.Name = "Footlight MT Light"
sh.Cells(r, c).Font.ColorIndex = 5
sh.Cells(r, c).Font.Size = 14

sh.Cells(r, c + 1).Value = Data
sh.Cells(r, c + 1).Font.Name = sh.Cells(r, c).Value
sh.Cells(r, c + 1).Font.Size = 14
r = r + 1
Next

sh.Name = "Font Styles"
sh.UsedRange.Columns.AutoFit

'Restore the sheet count in newly created workbook
Application.SheetsInNewWorkbook = 3

End Sub