Originally Posted by
AnnaL
That's OK, thank you. I'll throw it back to gmaxey, do you have any ideas?
Yes, this is not a free code writing service. If you don't want to learn how to write code then hire someone to write if for you.
I told you in my last post that the code I provided would get the first leading and trailing flag (and not any that might prefix or suffix those). You can try this:
Sub CopyDocTablesToClipboard()
Dim oTbl As Table
Dim oDoc As Document
Dim oTempDoc As Document
Dim oRng As Range, oCopyRange As Range, oFlagRange As Range
Dim arrIncludes() As String
Dim lngIndex As Long
Application.ScreenUpdating = False
Set oDoc = ActiveDocument
arrIncludes = Split("tcl,abc,def,ghi", ",")
Set oTempDoc = Documents.Add(ThisDocument.AttachedTemplate.FullName, , , False)
For Each oTbl In oDoc.Tables
Set oRng = oTempDoc.Range
oRng.Collapse wdCollapseEnd
Set oCopyRange = oTbl.Range
With oCopyRange
'Get first leading and trailing flags
If .Characters.First.Previous.Previous = ">" Then
.MoveStartUntil "<", wdBackward
.MoveStart 1, -1
End If
'Get first leading and trailing flags
If .Characters.Last.Next = "<" Then
.MoveEndUntil ">", wdForward
.MoveEnd 1, 1
Set oFlagRange = .Paragraphs.Last.Next.Range
If oFlagRange.Characters.First = "<" And oFlagRange.Characters.Last.Previous = ">" Then
For lngIndex = 0 To UBound(arrIncludes)
If InStr(oFlagRange.Text, "<" & arrIncludes(lngIndex) & ">") = 1 Then
.End = oFlagRange.End
Exit For
End If
Next
End If
End If
.Select
.Copy
End With
oRng.Paste
Set oRng = oTempDoc.Range
oRng.Collapse wdCollapseEnd
oRng.InsertAfter vbCr
Next oTbl
oTempDoc.Range.Copy
oTempDoc.Close wdDoNotSaveChanges
lbl_Exit:
Exit Sub
End Sub