EXCEL取值填至WORD指定表格老出错

hy760318

做了一段代码，主要目的是根据条件把EXCEL中的内容放到指定的符合条件的第B张表格中，结果老是提示出错，希望高手们帮忙看下是哪儿出问题了，谢谢！
Private Sub 导至该井施工方案_Click()
  Dim filename, arr, wdapp, cel, i%, n%, kd, b, j
     filename = Application.GetOpenFilename _
        (FileFilter:="word Files (*.doc),*.doc," _
        & "Word Files (*.docx),*docx", _
        Title:="请选择需要填充数据的word文件")
    If filename = False Then Exit Sub
    If InStr(1, filename, Sheets("3施工方案1").Cells(1, 5)) = 0 Then
        i = MsgBox("非" & Sheets("3施工方案1").Cells(1, 5) & "单井提速创效施工方案，请重新选择！", 0 + 48 + 256 + 65536, "提示：")
        Exit Sub
    End If
   
    arr = Sheets("3施工方案1").[a1].CurrentRegion
    Set wdapp = CreateObject("word.application")
    wdapp.Visible = True            
      With wdapp.Documents.Open(filename)
         j = ActiveDocument.Tables.Count '表格的个数
           kd = Sheets("3施工方案1").Cells(1, 2) '取excel中第1行第2列的值，以判断是几开
        If Sheets("3施工方案1").Cells(1, 2) Like "*一开*" Then
            b = 1
            wdapp.Quit
            i = MsgBox(filename & "文件中已有对应方案！", 0 + 48 + 256 + 65536, "提示：")
            Exit Sub
           If Sheets("3施工方案1").Cells(1, 2) Like "*二开*" Then
                b = 2
             If Sheets("3施工方案1").Cells(1, 2) Like "*三开*" Then
                   b = 3
                If Sheets("3施工方案1").Cells(1, 2) Like "*四开*" Then
                     b = 4
                   If Sheets("3施工方案1").Cells(1, 2) Like "*五开*" Then
                         b = 5
        Else
            i = MsgBox(filename & "该文件中无此" & kd & "对应方案", 0 + 48 + 256 + 65536, "提示：")
            Exit Sub
            'wdapp.Quit
                   End If
                End If
             End If
           End If
        End If
        
        '以下语句是确定word表格已有数据的行数
             Tables(b).Columns(1).Select
        For Each cel In .Parent.Selection.Cells
            n = n + 1
            If cel.Range.Text = Chr(13) & Chr(7) Then   
                n = n - 1
                Exit For
            End If
        Next
            If UBound(arr) = n Then GoTo over
        
        '首先在word表格的第n行以下增加UBound(arr)-n行空行.这个行范围就是需要传送的数据行
        .Tables(b).Rows(n).Select
        .Parent.Selection.InsertRowsBelow UBound(arr) - n
        For i = n + 1 To UBound(arr)
            .Tables(b).Cell(i, 1).Range = arr(i, 1)
            .Tables(b).Cell(i, 2).Range = arr(i, 2)
            .Tables(b).Cell(i, 3).Range = Format$(arr(i, 3), "Standard")
            .Tables(b).Cell(i, 4).Range = Format$(arr(i, 4), "Standard")
        Next
over:
        .Save
        .Close wdSaveChanges
        wdapp.Quit
    End With
End Sub

hy760318

另外这个子过程前面还能运行，只是出错！刚才突然显示子过程或函数未定义——头大了！