вырезать листы по условию

[D_e_n_n]

у меня есть файл из 3000 листов, в нем есть на каждом листе в шапке слова "Приложение № 4" либо "Приложение № 5" мне необходимо разделить этот документ на два, в одном приложения № 5 в другом Приложения № 4 .

дак вот можно ли сделать так , чтобы макросом пройтись и вырезать в другой документ все листы с текстом Приложение № 4?

[D_e_n_n]

я так понял, что нельзя!?

[shanemac51]

приложите пару страниц

-может ли 1 приложение занимать более листа
-если спец-инфа забейте
ааааааааааааааа ооооооооооооооооо дддддддддддд

важна схема документа и принцип создания

[D_e_n_n]

Сообщение от shanemac51

приложите пару страниц

-может ли 1 приложение занимать более листа
-если спец-инфа забейте
ааааааааааааааа ооооооооооооооооо дддддддддддд

важна схема документа и принцип создания

приложение 4 так и должно быть в другом документе без коллонтитул

[shanemac51]

'' разметьте c:\temp
Dim j1, s1, sdoc, spath
Dim pr As Paragraph
Sub w110317_0900()
sdoc = Word.ActiveDocument.FullName
w110317_0937 "Приложение №", 4
w110317_0937 "Приложение №", 5
Word.Application.Quit
End Sub
Sub w110317_0937(n1z, n2z)
Word.ActiveDocument.Close
Word.Documents.Open sdoc
Word.ActiveDocument.SaveAs "c:\temp\" & n1z & n2z & ".doc"
j1 = Word.ActiveDocument.Sections.Count
Debug.Print j1
Do While j1 > 0
  For Each pr In Word.ActiveDocument.Sections(j1).Range.Paragraphs
  s1 = pr.Range.Text
    If s1 Like "*" & n1z & "*" Then
      If s1 Like "*" & n2z & "*" Then
      Else
      Debug.Print n1z, n2z, s1
      Word.ActiveDocument.Sections(j1).Range.Delete
      End If
    End If
  Next pr
j1 = j1 - 1
Loop
If n2z = 4 Then
WordBasic.RemoveHeader
WordBasic.RemoveFooter
End If
Word.ActiveDocument.Save
  
End Sub

при 3000 листов оптимальнее

-перегнать в 2 таблицы аксесса
таб1 -голова, приложение,договор
таб2 -табличная часть
-поиск по любому из 13 столбиков и распечаткой конкретного номера