Sub Test()
    Dim WB As Workbook, vModule As VBComponent, i As Long
    
    Application.ScreenUpdating = False
    Set WB = Workbooks.Add(1)
    Set vModule = WB.VBProject.VBComponents.Add(vbext_ct_StdModule)
    
    With vModule.CodeModule
        i = .CountOfLines + 1
        .InsertLines i, "Sub Test()"
        i = i + 1
        .InsertLines i, "   MsgBox ""Hello!"", vbInformation, ""Test"" "
        i = i + 1
        .InsertLines i, "End Sub"
    End With
    
    WB.SaveAs ThisWorkbook.Path & Application.PathSeparator & "TestFile.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled '52
    WB.Close (True)
    Application.ScreenUpdating = True
    MsgBox "Файл создан!", vbInformation, "Конец"
End Sub