Use VBA with Powerpoint to Search titles in a Word Doc and Copy Text into another Word Document -

i'm working on powerpoint slide, few texts listed. have search these texts in word document has lot of headings , texts. after find title text, need copy text under heading , paste in new document.

basically, vba coding has done in powerpoint vba, 2 documents in background searching text , pasting in another.

i've opened word doc. searching text in , selecting copying document i've not been able do. kindly me.

i see. following not elegant since uses selection try avoid way know achieve such thing.

disclaimer 1: made in word vba, need slight adaption, set reference word, use wrdapp = new word.application object , declare doc , newdoc explicitely word.document.

disclaimer 2: since search text instead of respective heading, beware find first occurence of text better not have same text in several chapters. ;-)

disclaimer 3: cannot paste anymore! :-( clipboard set, pastes elsewhere cannot paste in here. code follows first edit, in minute...

edit: yepp, pasting works again. :-)

sub findchapter()  dim doc document, newdoc document dim startrange long, endrange long dim headingtofind string, chaptertofind string  chaptertofind = "zgasfdiukzfdggsdaf" 'just testing  set doc = activedocument set newdoc = documents.add doc.activate selection.homekey unit:=wdstory  selection     .find         .clearformatting         .text = chaptertofind         .matchwildcards = false         .matchcase = true         .execute     end      if .find.found     '**********     'find preceding heading know chapter starts     '**********         .collapse wdcollapsestart         .find             .text = ""             .style = "heading 1"             .forward = false             .execute             if not .found                 msgbox "could not find chapter heading"                 exit sub             end if         end          .movedown count:=1         .homekey unit:=wdline         startrange = .start          '*********         'find next heading know chapter ends         '*********         .find.forward = true         .find.execute         .collapse wdcollapsestart         .moveup count:=1         .endkey unit:=wdline         endrange = .end          doc.range(startrange, endrange).copy         newdoc.content.paste         newdoc.saveas2 doc.path & "\" & headingtofind & ".docx", wdformatflatxml     else         msgbox "chapter not found"     end if  end   end sub 

edit: if need search "feature" in table in column 1 description in column 2 , need description in new doc, try this:

sub findfeature()  dim doc document, newdoc document dim featuretofind string dim ro long, tbl table  featuretofind = "zgasfdiukzfdggsdaf"   'just testing  set doc = activedocument set newdoc = documents.add doc.activate selection.homekey unit:=wdstory  selection     .find         .clearformatting         .text = featuretofind         .matchwildcards = false         .matchcase = true         .execute     end      if .find.found         set tbl = selection.tables(1)         ro = selection.cells(1).rowindex         tbl.cell(ro, 2).range.copy         newdoc.range.paste     end if end   end sub 

edit: slight adaptation can paste without overwriting existing content in newdoc: instead of newdoc.range.paste use along line of this:

 dim ran range  set ran = newdoc.range  ran.start = ran.end  ran.paste