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

我必须编写一个宏来创建许多使用相同数据的不同报告。一切按我所希望的方式工作，但我不能一个接一个地使用任何两个宏，我的意思是我必须重新启动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

---

尝试在末尾添加

Set wd=Nothing

。此错误发生在哪一行？如果打开任务管理器，是否可以看到任何孤立的winword.exe进程？请尝试将wd设置为Word.Application并将

Set wd=New Word.Application

放置在Sub.^^内，而不应

ActiveDocument.Bookmarks

为

wd.ActiveDocument.Bookmarks

？如果没有

wd.

，您将生成Word应用程序对象的另一个实例，该实例在关闭Excel之前不会关闭。谢谢！所有这些答案结合在一起，给出了我想要的结果：DTry在末尾添加

Set wd=Nothing

。此错误发生在哪一行？如果打开任务管理器，是否可以看到任何孤立的winword.exe进程？请尝试将wd设置为Word.Application并将

Set wd=New Word.Application

放置在Sub.^^内，而不应

ActiveDocument.Bookmarks

为

wd.ActiveDocument.Bookmarks

？如果没有

wd.

，您将生成Word应用程序对象的另一个实例，该实例在关闭Excel之前不会关闭。谢谢！所有这些答案加在一起，给了我想要的结果：D