Найти и скопировать таблицы с 1 строкой

Question

У меня есть документ Word с несколькими таблицами, и я хочу скопировать и поместить в новый документ только те таблицы с 1 строкой. У меня есть код VBA для копирования всех таблиц из исходного документа в новый документ, но я хочу скопировать только эти таблицы с 1 строкой. Вот код, который у меня есть (кредит: WordTips, The Macros ed 9)

Sub CopyTables()
  Dim Source As Document
  Dim Target As Document
  Dim tbl As Table
  Dim tr As Range
Set Source = ActiveDocument
Set Target = Documents.Add

For Each tbl In Source.Tables
Set tr = Target.Range
tr.Collapse wdCollapseEnd
tr.FormattedText = tbl.Range.FormattedText
tr.Collapse wdCollapseEnd
tr.Text = vbCrLf
Next
End Sub

Answer 1

Используйте свойство Count tbl чтобы узнать, сколько у вас Rows .

Option Explicit

Sub CopyTables()
    Dim Source As Document
    Dim Target As Document
    Dim tbl As Table
    Dim tr As Range
    Set Source = ActiveDocument
    Set Target = Documents.Add

    For Each tbl In Source.Tables
        If tbl.Rows.Count = 1 Then
            Set tr = Target.Range
            tr.Collapse wdCollapseEnd
            tr.FormattedText = tbl.Range.FormattedText
            tr.Collapse wdCollapseEnd
            tr.Text = vbCrLf
        End If
    Next
End Sub