Copy/Paste/Delete Table & Section etc.

flds · #3 06-07-2011, 05:37 PM

Hello P. Edstein,
Thank you so much for your reply.
Most of the documents are portrait and say few documents may have columns specially in the appendix sections. If I come across such situation I could do these sections manually or do the whole document manually.
I have found a few of the macros on the web, I do not know how to put them together in one macro. I would like to combine these macros into one macro, is it too much to do?
Paul, the Reference section is the second last section in the document. This is a string with bullets.
the Appendix section is the last section in all documents, it starts as “Appendix ‘A’ “ and so on.
The tables need to be copied first and then deleted.
The macro “CopyTablesIntoNewDocument()” works on some documents and does not work on some, can this be fixed.
The document does not need formatting.
I tried deleting the TOC it does not delete.
I hope you could combine all these macros into one. If possible to add a section delete macro.
Appreciate your time and effort.
Thanks again.
FLDS
Macros:

Code:

Sub HyperlinkDelete()
Dim i As Long
For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
  ActiveDocument.Hyperlinks(i).Delete
Next i
End Sub

Code:

Sub DeleteSectionBreaks()
With ActiveDocument.Content.Find
  .ClearFormatting
  .Text = "^b"
  With .Replacement
    .ClearFormatting
    .Text = ""
  End With
  .Execute Replace:=wdReplaceAll
End With
End Sub

Code:

Sub ReplaceNonBreakingHyphen()
With ActiveDocument.Content.Find
  .ClearFormatting
  .Text = "^~"
  With .Replacement
    .ClearFormatting
    .Text = "^-"
  End With
  .Execute Replace:=wdReplaceAll
End With
End Sub

Code:

Sub DeleteAllTables()
Dim oTable As Table
For Each oTable In ActiveDocument.Tables
  oTable.Delete
Next oTable
End Sub

Code:

Sub SectionDelete()
Dim TOC As TableOfContents
Set TOC = ActiveDocument.TablesOfContents(1)
With ActiveDocument
  .Sections(2).Range.Delete
  TOC.Update
End With
End Sub

Code:

Sub CopyTablesIntoNewDocument()
 ' version 1.0
 ' http://www.pdfhacks.com/copytables/
Dim SrcDoc, NewDoc As Document
Dim SrcDocTableRange As Range
Set SrcDoc = ActiveDocument
If SrcDoc.Tables.Count <> 0 Then
  Set NewDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
  Set NewDocRange = NewDoc.Range
  Dim PrevPara As Range
  Dim NextPara As Range
  Dim NextEnd As Long
  NextEnd = 0
  For Each SrcDocTable In SrcDoc.Tables
    Set SrcDocTableRange = SrcDocTable.Range
     'output the preceding paragraph?
    Set PrevPara = SrcDocTableRange.Previous(wdParagraph, 1)
    If PrevPara Is Nothing Or PrevPara.Start < NextEnd Then
    Else
      Set PPWords = PrevPara.Words
      If PPWords.Count > 1 Then 'yes
        NewDocRange.Start = NewDocRange.End
        NewDocRange.InsertParagraphBefore
        NewDocRange.Start = NewDocRange.End
        NewDocRange.InsertParagraphBefore
        NewDocRange.FormattedText = PrevPara.FormattedText
      End If
    End If
     'output the table
    NewDocRange.Start = NewDocRange.End
    NewDocRange.FormattedText = SrcDocTableRange.FormattedText
     'output the following paragraph?
    Set NextPara = SrcDocTableRange.Next(wdParagraph, 1)
    If NextPara Is Nothing Then
    Else
      Set PPWords = NextPara.Words
      NextEnd = NextPara.End
      If PPWords.Count > 1 Then 'yes
        NewDocRange.Start = NewDocRange.End
        NewDocRange.InsertParagraphBefore
        NewDocRange.FormattedText = NextPara.FormattedText
      End If
    End If
  Next SrcDocTable
End If
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
copy and paste not working	Ellie	Word	3	11-07-2013 02:23 PM
Can't copy paste	irenasobolewska	Office	2	10-26-2012 05:09 PM
Copy - Paste between 2 tables	rod147	Excel	1	10-22-2009 08:21 PM
Copy & paste low resolution	worriedme	Drawing and Graphics	0	06-01-2009 03:05 AM
Copy and paste special	Dace	Excel	2	02-16-2009 12:18 PM