VBA，远程服务器机器，不能运行多次

Question

我必须编写一个宏来创建许多使用相同数据的不同报告。一切都按我想要的方式工作，但我不能一个接一个地使用任何2个宏，我的意思是我必须重新启动excel才能运行第二个宏。这是宏的代码。其他的都差不多，但复制的值是不同的。基本上我不能一个接一个地运行两个宏，因为远程服务器机器不存在或不可用。任何帮助，将不胜感激！

    Option Explicit
    'change this to where your files are stored
    Dim UserName As String
    Dim wd As New Word.Application
    Dim SegtuvasCell As Range

    Sub Audito_Ataskaita()

    Dim val As String
    UserName = Environ("USERNAME")
    val = InputBox("iveskite papkes numeri, kuriai kurti ataskaitas", "Neidomu cia, neskaitykit")
    val = val + 1
    'Const FilePath As String = "C:\Users\" & Vardas & "\Desktop\Ataskaitu generavimas\"
    'Const FilePath2 As String = "C:\Users\Sarunas\Desktop\Ataskaitu generavimas\Ataskaitos\Audito ataskaita\"
    'create copy of Word in memory
    'MsgBox "Entered value is " & Range("A1").Value
    'Dim ThisRng As Range
    'Set ThisRng = Application.InputBox("Select a range", "Get Range", Type:=8)
    Dim doc As Word.Document
    wd.Visible = True
    Dim SegtuvasRange As Range
    'create a reference to all the people
    Range("A" & val).Select
    Set SegtuvasRange = Range( _
    ActiveCell, _
    ActiveCell)
    'for each Segtuvas in list ??½
    'For Each SegtuvasCell In SegtuvasRange
    For Each SegtuvasCell In SegtuvasRange
    'open a document in Word
    Set doc = wd.Documents.Open("C:\Users\" & UserName & "\Desktop\Ataskaitu generavimas" & "\Audito ataskaita.docx")
    'go to each bookmark and type in details
    CopyCell "Imone", 1
    CopyCell "Adresas", 2
    CopyCell "Indeksas", 3
    CopyCell "Igaliotinis", 5
    CopyCell "UzsakNr", 6
    CopyCell "Standartas", 7
    CopyCell "AuditoRusis", 8
    CopyCell "Data", 9
    CopyCell "sritis", 10
    CopyCell "reikalavimai", 12
    CopyCell "skaicius", 13
    CopyCell "Vadovas", 14
    CopyCell "Auditorius", 15
    CopyCell "TechEx", 16
    CopyCell "Stazuotojas", 17
    CopyCell "KitiAsm", 18
    CopyCell "EA", 11
    ActiveDocument.Bookmarks("Footer").Range.InsertAfter _
      "" & Cells(SegtuvasCell + 1, 2) & " 099 F Auditbericht 1703_lt"
    'save and close this document
    'MsgBox "Entered value is " & Range(SegtuvasRange).Value
    doc.SaveAs2 "C:\Users\" & UserName & "\Desktop\Ataskaitu generavimas\Ataskaitos\Audito ataskaita\" & Cells(SegtuvasCell + 1, 2) & " " & "099 F Auditbericht 1703_lt" & ".docx"
    doc.Close
    Next SegtuvasCell
    wd.Quit
    MsgBox "Created files in" & "C:\Users\" & UserName & "\Desktop\Ataskaitu generavimas\Ataskaitos\Audito ataskaita\"
    End Sub
    Sub CopyCell(BookMarkName As String, ColumnOffset As Integer)
    'copy each cell to relevant Word bookmark
    wd.Selection.GoTo What:=wdGoToBookmark, Name:=BookMarkName
    wd.Selection.TypeText SegtuvasCell.Offset(0, ColumnOffset).Value
    Exit Sub

End Sub