#1
|
|||
|
|||
Find, copy and paste into a new page
Good morning,
I'm trying to create a macro that will find a certain word, let's say "test" and then it will copy all the text between 2 certain points(***** and *****) in the doc. Then it will paster into a new doc called "test" and number each one. Below is an example. ***** hello goodbye test nice extremely cold ***** Not all instances are this simple. Some only have 5 lines of text between the "*****", as the example above, ans some have up to 30 lines of text. Also, if possible I would like each instance to be pasted into a new page within the same doc after the first instance is found. It would also give a total on the first line of the doc. Thanks in advance. |
#2
|
||||
|
||||
Cross-posted at: http://www.excelforum.com/word-progr...-new-page.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Sorry about the cross posting. I didn't think about someone doing double work or trying to solve a problem when someone on another forum already had.
I've been working on my above dilema and have a working macro(found it online and have been able to modify it a bit to my needs). I'm just trying to modify it a bit. Instead of searching 1 word or phrase at a time is there a way to have a list and it can pull from the next word or phrase with each loop until it hits the end? Also is the a way to number each hit and put it all into 1 doc. Below is the code that I have so far. Code:
Sub Demo() Dim SearchTerm As String, i As Long Dim Rng As Range, Doc As Document, RngOut As Range SearchTerm = InputBox("Enter your search terms") SearchTerm = LCase(Trim(SearchTerm)) If Len(SearchTerm) = 0 Then Exit Sub With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = SearchTerm .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .Execute End With If .Find.Found Then Set Doc = Documents.Add(Visible:=False) Do While .Find.Found Set Rng = .Duplicate With Rng .MoveStartUntil Cset:="^^^^^", Count:=wdBackward .MoveEndUntil Cset:="^^^^^", Count:=wdForward .Select If MsgBox(.Text, vbYesNo, "Copy this block?") = vbYes Then .Copy With Doc .Range.InsertAfter "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" Set RngOut = .Characters.Last RngOut.Paste End With End If End With .Collapse wdCollapseEnd .Find.Execute Loop Doc.Activate ActiveWindow.Visible = True End If End With End Sub |
#4
|
||||
|
||||
Try something along these lines:
Code:
Sub Demo() Application.ScreenUpdating = False Dim strFnd As String, wdDoc As Document, i As Long, j As Long strFnd = InputBox("What is the Text to Find") If Trim(strFnd) = "" Then Exit Sub With ActiveDocument.Range j = .End With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "^94[!^94]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found = True With .Duplicate .Start = .Start + 1 .MoveEndUntil Cset:="^", Count:=wdForward If InStr(.Text, strFnd) Then If wdDoc Is Nothing Then Set wdDoc = Documents.Add i = i + 1 While .Characters.First = vbCr .Start = .Start + 1 Wend .Copy With wdDoc.Range .InsertAfter Chr(12) & "Instance: " & i & vbCr .Characters.Last.Paste While .Characters.Last.Previous.Previous = vbCr .Characters.Last.Previous.Previous.Delete Wend End With End If If .End = j Then Exit Do End With .Collapse wdCollapseEnd .Find.Execute Loop End With If Not wdDoc Is Nothing Then wdDoc.Characters.First.Delete Set wdDoc = Nothing Application.ScreenUpdating = True MsgBox i & " instances found." End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] Last edited by macropod; 09-20-2012 at 10:01 PM. |
#5
|
|||
|
|||
Thanks for the response. I have a couple of questions. First, do I type all of the words or phrase at once into the dialog box separated by commas? Second, I don't see the below code from my post:
Code:
With Rng .MoveStartUntil Cset:="^^^^^", Count:=wdBackward .MoveEndUntil Cset:="^^^^^", Count:=wdForward .Select .Copy With Doc .Range.InsertAfter "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" |
#6
|
|||
|
|||
Ok, I was able to modify the code so that it knows what lines to copy to and insert the ^^^^ separator. Only part I'm stuck with is how to enter the different phrases to look for.
Thanks, |
#7
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
||||
|
||||
Quote:
Were you wanting to look for multiple words/phrases at a time? I so, should all the matches be output to the same document, or to a different document for each word/prhase?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Yes, there are multiple phrases to look for and they all need to go on the same doc. On another note, nothing to do with this macro. Is it possible for a macro to search a certain phrase and then you can tell it to look for a certain word above that word and copy an entire line or portion of the line?
Thanks, |
#10
|
||||
|
||||
Try the following. It usues the pipe character (ie '|') as the expression separator. I've added a few tweaks to the output as well.
Code:
Sub Demo() Application.ScreenUpdating = False Dim strFnd As String, wdDoc As Document, i As Long, j As Long, k As Long strFnd = InputBox(vbTab & "What is the Text Array to Find?" & vbCr & "Use the '|' character to separate array elements.") If Trim(strFnd) = "" Then Exit Sub With ActiveDocument.Range j = .End With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "^94[!^94]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found = True With .Duplicate .Start = .Start + 1 .MoveEndUntil Cset:="^", Count:=wdForward For k = 0 To UBound(Split(strFnd, "|")) If InStr(.Text, Split(strFnd, "|")(k)) > 0 Then If wdDoc Is Nothing Then Set wdDoc = Documents.Add i = i + 1 While .Characters.First = vbCr .Start = .Start + 1 Wend .Copy With wdDoc.Range .InsertAfter Chr(12) If i = 1 Then .InsertAfter "Search Expression: " & strFnd & vbCr .InsertAfter "Instance: " & i & vbTab & "First matched on: " & Split(strFnd, "|")(k) & vbCr .Characters.Last.Paste While .Characters.Last.Previous.Previous = vbCr .Characters.Last.Previous.Previous.Delete Wend End With Exit For End If Next If .End = j Then Exit Do End With .Collapse wdCollapseEnd .Find.Execute Loop End With If Not wdDoc Is Nothing Then wdDoc.Characters.First.Delete Set wdDoc = Nothing Application.ScreenUpdating = True MsgBox i & " instances found." End Sub Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Haven't gotten a chance to test the code but I will, thanks. I also started another post in reference to the above question. Heres a link to it, thanks.
https://www.msofficeforums.com/word-...d-another.html |
#12
|
|||
|
|||
Hey, maropod.
I tested the code but I can't get it to work. It only finds the first phrase. It doesn't find any of the others ones. Also, the one it does find it doesn't copy every thing between the "^^". It only copies about 5 lines or so. Thanks for your help. Last edited by jperez84; 09-17-2012 at 08:45 AM. |
#13
|
|||
|
|||
I think I found why it wasn't working for me. Is there a max number of characters for the input box?
|
#14
|
||||
|
||||
The maximum string length for an InputBox is 254 characters. Aside from that, the code worked fine in my testing.
If you can attach a document to a post with some representative data (delete anything sensitive), I can do some more testing. You can attach documents via the paperclip symbol on the 'Go Advanced' tab.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
I wish I could but can't. What's weird is that it's not finding everything separates by | even though its in the doc. Is there a way to have it read from a list?
|
Thread Tools | |
Display Modes | |
|
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 |
special copy/paste | iconofsin | Excel | 1 | 09-15-2010 12:10 AM |
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 |