求助修改代码

秦_人

求助各位大侠修改一下代码符合附件中的WROD格式，谢谢
Private Sub CommandButton1_Click()
Dim MyWord As New Word.Application, MP, nf, i, j
MP = ThisWorkbook.Path
arr = Sheet1.UsedRange
   For i = 2 To UBound(arr)
      n = 0
      ReDim brr(1 To UBound(arr), 1 To 8)
      If arr(i, 2) <> "" Then
         For r = i To UBound(arr)
          n = n + 1
            For j = 1 To 8
            brr(n, j) = arr(r, j)
            Next
            If r <> UBound(arr) Then
             If arr(r + 1, 2) <> "" Then Exit For
             End If
           Next
       FileCopy MP & "\户口簿.doc", MP & "\户口簿" & "(" & arr(i, 3) & ").doc"
       nf = MP & "\户口簿" & "(" & arr(i, 3) & ").doc"
       With MyWord
         .Documents.Open nf
         .Visible = False
         .ActiveDocument.Tables(1).cell(1, 2).Range = brr(1, 3)
         .ActiveDocument.Tables(1).cell(1, 4).Range = brr(1, 4)
         .ActiveDocument.Tables(1).cell(1, 6).Range = brr(1, 5)
         .ActiveDocument.Tables(1).cell(2, 2).Range = brr(1, 6)
         .ActiveDocument.Tables(1).cell(2, 4).Range = brr(1, 8)
         .ActiveDocument.Tables(1).cell(3, 2).Range = brr(1, 2)
          For s = 2 To n
         .ActiveDocument.Tables(1).cell(s + 4, 1).Range = brr(s, 3)
         .ActiveDocument.Tables(1).cell(s + 4, 2).Range = brr(s, 5)
         .ActiveDocument.Tables(1).cell(s + 4, 3).Range = brr(s, 4)
         .ActiveDocument.Tables(1).cell(s + 4, 4).Range = brr(s, 8)
         Next
        End With
       Erase brr
       MyWord.Documents.Save
End If
Next
MyWord.Quit
Set MyWord = Nothing
End Sub

秦_人

求高手解决一下了

秦_人

求高手解决一下了

zhewin

学习一下