Sub CopyDocs()
'Graham Mayor - http://www.gmayor.com - Last updated - 13 Nov 2017
Dim oDoc As Document
Dim strName As String
Dim strExt As String
Dim strPath As String
Dim iNum As Integer
Dim fso As Object
    Set oDoc = ActiveDocument
    If Not oDoc.Path = "" Then
        strExt = Mid(oDoc.Name, InStrRev(oDoc.Name, Chr(46)))
        If Len(oDoc.Name) = 3 + Len(strExt) And Mid(oDoc.Name, 3, 1) = "1" Then
            strPath = oDoc.Path & Chr(92)
            strName = Left(oDoc.Name, 2)
            Set fso = CreateObject("Scripting.FileSystemObject")
            For iNum = 2 To InputBox("Enter the total number of documents to be created", , 35)
                fso.CopyFile strPath & strName & "1" & strExt, strPath & strName & CStr(iNum) & strExt
            Next iNum
        Else
            MsgBox "Filename in the wrong format!"
        End If
    Else
        MsgBox "Document not saved."
    End If
    MsgBox iNum - 1 & " copies created"
lbl_Exit:
    Set oDoc = Nothing
    Set fso = Nothing
    Exit Sub
End Sub