Remove page (from multiple documents) and insert in new document

[Dylan]

I've had a go at it but it doesn't work. The source and
target files open then nothing happens. Why isn't it
pasting?


Public Sub ExtractAsbestosSummary()


Dim aSection As Section
Dim aRange As Range
Dim Source As Document
Dim Target As Document
Dim Flag As Integer
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long



PathToUse = "P:\My Documents\General\Routine
Inspections\Building Inspections\HMNB Clyde\Pending\"

'Error handler to handle error generated whenever
'the FindReplace dialog is closed

On Error Resume Next

'Close all open documents before beginning

Documents.Close SaveChanges:=wdPromptToSaveChanges

'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")

While myFile <> ""

'Open document
Set myDoc = Documents.Open(PathToUse & myFile)

Set Source = ActiveDocument
For Each aSection In Source.Sections
If InStr(aSection.Headers
(wdHeaderFooterPrimary).Range, "Section 6") > 0 Then
Set aRange = aSection.Range
aRange.End = aRange.End - 1
aRange.Select
aRange.Copy
Flag = 0
Exit Sub
Else
Flag = 1
End If
Next aSection

'Close the document after saving changes
myDoc.Close


' Set and Open the Target document which is to be
pasted.
Set Target = Documents.Open
(FileName:="C:\WINNT\Profiles\dyland\Desktop\Asbestos.doc")
'Paste to Target Document
Target.Range.Paste

'Next file in folder

myFile = Dir$()

Wend

End Sub