Multiple question sets

[Bhavana]

I have three different word files on different topics with 30 questions in
each file.
I want VBA code for copying 5 questions from each file & paste it in new
file and make a fresh question paper. For e.g. I want page no 1 & 3
questions /answers to copy & paste from each file.
I tried to record but could not succeed as one question is lengthy to fit
in 2 lines & other is short to fit in one line only. Hence my objective
options order also gets changed.
A question differs every time because 5 sets of question papers are on
different
topics. for e.g. set 1- questions are general knowledge, set2 - questions
are mathematics, set 3 - questions are on technical knowledge etc...
for example.

Q.1 Choose Appropriate example for Local area network (LAN)
Option1 - Connection within a building.
Option2 - Connection within a city.
Option3 - Connection across countries

Q.2 In Communications, more amount of data can be transferred in less time
if the size of the bandwidth available is more.
Option1 - true
Option2 - false.

In the above examples question 1 finishes in 1st line only and has only 3
options whereas question 2 is lengthy and has only 2 options.

Can you help Sir?? I am using windows 2007.

 

[Graham Mayor]

You have three files each with 30 questions and their answers - 90
questions - laid out as your example and numbered, presumably, Q1 to Q30?
You want to select 5 questions from each of the three files and create a new
document containing 15 questions, and their answers?
The burning question is *which* five questions from each file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the files?
Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Bhavana]

Sir,

The first 5 questions from each file. for eg. 1st set will be 1st five
questions from each file 2nd set will be the next 5 questions i.e. question
no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word document as I
have another software to change questions order by system itself once I make
it online.

Renumbering will be added advantage.

bhavana

 

[Bhavana]

Sir,

The first 5 questions from each file. for eg. 1st set will be 1st five
questions from each file 2nd set will be the next 5 questions i.e. question
no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word document as I
have another software to change questions order by system itself once I make
it online.

Renumbering will be added advantage.

bhavana

 

[Graham Mayor]

The following macro should do what you ask, provided your 3 documents are
laid out as you indicated.
The macro assumes that the three original documents are named with the
number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the extension in the
line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set " _
& i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with the six
documents open.
The code can undoubtedly be simplified if you want to put the time into
doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set " _
& i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Bhavana]

Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not found. I
have saved all the three original files as per given path. Am I suppose to
give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set " _
& i & ".docx")

Sir where I am going wrong ??

--
tks

bhavana

The following macro should do what you ask, provided your 3 documents are
laid out as you indicated.
The macro assumes that the three original documents are named with the
number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the extension in the
line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set " _
& i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with the six
documents open.
The code can undoubtedly be simplified if you want to put the time into
doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set " _
& i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

The first 5 questions from each file. for eg. 1st set will be 1st five
questions from each file 2nd set will be the next 5 questions i.e.
question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word document
as I have another software to change questions order by system itself
once I make it online.

Renumbering will be added advantage.

bhavana

 

[Graham Mayor]

You will get an error unless you change the path to where you have stored
the three documents and unless the documents are named "Q Set 1.docx", "Q
Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor the line
should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set" & i &
".docx")

as this will probably wrap incorrectly too, maybe the following will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given path.
Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set "
_ & i & ".docx")

Sir where I am going wrong ??

The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named with
the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set
" _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with
the six documents open.
The code can undoubtedly be simplified if you want to put the time
into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

The first 5 questions from each file. for eg. 1st set will be 1st
five questions from each file 2nd set will be the next 5 questions
i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word document
as I have another software to change questions order by system
itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers - 90
questions - laid out as your example and numbered, presumably, Q1
to Q30? You want to select 5 questions from each of the three
files and create a new document containing 15 questions, and their
answers? The burning question is *which* five questions from each
file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the files?
Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30
questions in each file.
I want VBA code for copying 5 questions from each file & paste it
in new file and make a fresh question paper. For e.g. I want
page no 1 & 3 questions /answers to copy & paste from each file.
I tried to record but could not succeed as one question is lengthy
to fit in 2 lines & other is short to fit in one line only. Hence
my objective options order also gets changed.
A question differs every time because 5 sets of question papers
are on different
topics. for e.g. set 1- questions are general knowledge, set2 -
questions are mathematics, set 3 - questions are on technical
knowledge etc...
for example.

Q.1 Choose Appropriate example for Local area network (LAN)
Option1 - Connection within a building.
Option2 - Connection within a city.
Option3 - Connection across countries

Q.2 In Communications, more amount of data can be transferred in
less time if the size of the bandwidth available is more.
Option1 - true
Option2 - false.

In the above examples question 1 finishes in 1st line only and has
only 3 options whereas question 2 is lengthy and has only 2
options.

Can you help Sir?? I am using windows 2007.

 

[Bhavana]

Sir,

As advised by you I have made necessary changes. code is working fine but
at the end all the six final documents created by system goes blank.


--
tks

bhavana

You will get an error unless you change the path to where you have stored
the three documents and unless the documents are named "Q Set 1.docx", "Q
Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor the line
should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set" & i &
".docx")

as this will probably wrap incorrectly too, maybe the following will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given path.
Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set "
_ & i & ".docx")

Sir where I am going wrong ??

The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named with
the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set
" _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with
the six documents open.
The code can undoubtedly be simplified if you want to put the time
into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be 1st
five questions from each file 2nd set will be the next 5 questions
i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word document
as I have another software to change questions order by system
itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers - 90
questions - laid out as your example and numbered, presumably, Q1
to Q30? You want to select 5 questions from each of the three
files and create a new document containing 15 questions, and their
answers? The burning question is *which* five questions from each
file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the files?
Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30
questions in each file.
I want VBA code for copying 5 questions from each file & paste it
in new file and make a fresh question paper. For e.g. I want
page no 1 & 3 questions /answers to copy & paste from each file.
I tried to record but could not succeed as one question is lengthy
to fit in 2 lines & other is short to fit in one line only. Hence
my objective options order also gets changed.
A question differs every time because 5 sets of question papers
are on different
topics. for e.g. set 1- questions are general knowledge, set2 -
questions are mathematics, set 3 - questions are on technical
knowledge etc...
for example.

Q.1 Choose Appropriate example for Local area network (LAN)
Option1 - Connection within a building.
Option2 - Connection within a city.
Option3 - Connection across countries

Q.2 In Communications, more amount of data can be transferred in
less time if the size of the bandwidth available is more.
Option1 - true
Option2 - false.

In the above examples question 1 finishes in 1st line only and has
only 3 options whereas question 2 is lengthy and has only 2

 

[Graham Mayor]

That suggests that the three original documents are not quite as you
described them. The macro code is quite specific. Without the original
documents, I would be fishing in the dark to correct it. Are you able to
send me the thee documents? If so, zip them up and send them to the link on
the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.

You will get an error unless you change the path to where you have
stored the three documents and unless the documents are named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor the
line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set"
& i & ".docx")

as this will probably wrap incorrectly too, maybe the following will
help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3
documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given path.
Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set
" _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named with
the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with
the six documents open.
The code can undoubtedly be simplified if you want to put the time
into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be 1st
five questions from each file 2nd set will be the next 5 questions
i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word
document as I have another software to change questions order by
system itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers -
90 questions - laid out as your example and numbered,
presumably, Q1 to Q30? You want to select 5 questions from each
of the three files and create a new document containing 15
questions, and their answers? The burning question is *which*
five questions from each file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the files?
Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30
questions in each file.
I want VBA code for copying 5 questions from each file & paste
it in new file and make a fresh question paper. For e.g. I
want page no 1 & 3 questions /answers to copy & paste from each
file. I tried to record but could not succeed as one question
is lengthy to fit in 2 lines & other is short to fit in one
line only. Hence my objective options order also gets changed.
A question differs every time because 5 sets of question papers
are on different
topics. for e.g. set 1- questions are general knowledge, set2 -
questions are mathematics, set 3 - questions are on technical
knowledge etc...
for example.

Q.1 Choose Appropriate example for Local area network (LAN)
Option1 - Connection within a building.
Option2 - Connection within a city.
Option3 - Connection across countries

Q.2 In Communications, more amount of data can be transferred in
less time if the size of the bandwidth available is more.
Option1 - true
Option2 - false.

In the above examples question 1 finishes in 1st line only and
has only 3 options whereas question 2 is lengthy and has only 2

 

[Bhavana]

Sir,

I shall send you all the three documents. Sir, I am removing all Serial
nos. of question nos. I don't need it.

tks
--
tks

bhavana

That suggests that the three original documents are not quite as you
described them. The macro code is quite specific. Without the original
documents, I would be fishing in the dark to correct it. Are you able to
send me the thee documents? If so, zip them up and send them to the link on
the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.

You will get an error unless you change the path to where you have
stored the three documents and unless the documents are named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor the
line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set"
& i & ".docx")

as this will probably wrap incorrectly too, maybe the following will
help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3
documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given path.
Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q Set
" _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named with
the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes with
the six documents open.
The code can undoubtedly be simplified if you want to put the time
into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be 1st
five questions from each file 2nd set will be the next 5 questions
i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word
document as I have another software to change questions order by
system itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers -
90 questions - laid out as your example and numbered,
presumably, Q1 to Q30? You want to select 5 questions from each
of the three files and create a new document containing 15
questions, and their answers? The burning question is *which*
five questions from each file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the files?
Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30

 

[Graham Mayor]

OK I'll wait to see what turns up.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as you
described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you have
stored the three documents and unless the documents are named "Q
Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3
documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes
with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be
1st five questions from each file 2nd set will be the next 5
questions i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending order.

Yes I want them inserted subjectwise questions only in word
document as I have another software to change questions order by
system itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers -
90 questions - laid out as your example and numbered,
presumably, Q1 to Q30? You want to select 5 questions from each
of the three files and create a new document containing 15
questions, and their answers? The burning question is *which*
five questions from each file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the
files? Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30

 

[Graham Mayor]

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

OK I'll wait to see what turns up.

Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as you
described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you have
stored the three documents and unless the documents are named "Q
Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3
documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes
with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be
1st five questions from each file 2nd set will be the next 5
questions i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending
order. Yes I want them inserted subjectwise questions only in word
document as I have another software to change questions order
by system itself once I make it online.

Renumbering will be added advantage.

bhavana


You have three files each with 30 questions and their answers
- 90 questions - laid out as your example and numbered,
presumably, Q1 to Q30? You want to select 5 questions from
each of the three files and create a new document containing
15 questions, and their answers? The burning question is
*which* five questions from each file?
Do you want a particular selection or a random selection?
Do you want them inserted in the order they appear in the
files? Which order do you want to process the files in?
Will you then want the questions renumbering from 1 to 15?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
I have three different word files on different topics with 30

 

[Bhavana]

Sir,

I have sent at "send mail" icon at your web site & attached all three
documents have you received the same.

Sir, If you have not received with your due permission can I have your email
address...

bhavana
--
tks

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

OK I'll wait to see what turns up.

Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as you
described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you have
stored the three documents and unless the documents are named "Q
Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the 3
documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary changes.
The original documents are not affected and the macro finishes
with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be
1st five questions from each file 2nd set will be the next 5
questions i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending
order. Yes I want them inserted subjectwise questions only in word
document as I have another software to change questions order
by system itself once I make it online.

Renumbering will be added advantage.

bhavana

 

[Graham Mayor]

I have not to date received the documents. The e-mail address is support AT
gmayor.com replace ' AT ' with @.
The link on the home page of my web site www.gmayor.com will create a
message with this address pre-inserted. DO NOT change the subject or it may
be treated as spam. If your documents are large, your e-mail system may not
allow them to be sent as attachments. Use a compression tool like WinZip or
WinRar to reduce their size and maybe send as three separate messages.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I have sent at "send mail" icon at your web site & attached all three
documents have you received the same.

Sir, If you have not received with your due permission can I have
your email address...

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

OK I'll wait to see what turns up.


Bhavana wrote:
Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as
you described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you
have stored the three documents and unless the documents are
named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the
3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary
changes. The original documents are not affected and the
macro finishes with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test1.docx"
End With
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

The first 5 questions from each file. for eg. 1st set will be
1st five questions from each file 2nd set will be the next 5
questions i.e. question no.6 to 10 from each file & so on.

In this example I want particilar selection i.e. asending
order. Yes I want them inserted subjectwise questions only
in word document as I have another software to change
questions order
by system itself once I make it online.

Renumbering will be added advantage.

bhavana

 

[Bhavana]

Sir,

I have changed the subject both the times when I have sent it before...

Resent as advised by you,

bhavana
--
tks

bhavana

I have not to date received the documents. The e-mail address is support AT
gmayor.com replace ' AT ' with @.
The link on the home page of my web site www.gmayor.com will create a
message with this address pre-inserted. DO NOT change the subject or it may
be treated as spam. If your documents are large, your e-mail system may not
allow them to be sent as attachments. Use a compression tool like WinZip or
WinRar to reduce their size and maybe send as three separate messages.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I have sent at "send mail" icon at your web site & attached all three
documents have you received the same.

Sir, If you have not received with your due permission can I have
your email address...

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Graham Mayor wrote:
OK I'll wait to see what turns up.


Bhavana wrote:
Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as
you described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you
have stored the three documents and unless the documents are
named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the
3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary
changes. The original documents are not affected and the
macro finishes with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With

 

[Graham Mayor]

There is no reason attributable to my end of the e-mail system why messages
sent to my e-mail address are not being received - but I still have not
received them. Try sending a message without an attachment and we will
discuss an alternative approach privately. Duplicate the message to
gmayorATmvps.org - replacing AT with @. That address is heavily spam
filtered so do not attach your documents there. Simply use it as a point of
contact

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I have changed the subject both the times when I have sent it
before...

Resent as advised by you,

bhavana

I have not to date received the documents. The e-mail address is
support AT gmayor.com replace ' AT ' with @.
The link on the home page of my web site www.gmayor.com will create a
message with this address pre-inserted. DO NOT change the subject or
it may be treated as spam. If your documents are large, your e-mail
system may not allow them to be sent as attachments. Use a
compression tool like WinZip or WinRar to reduce their size and
maybe send as three separate messages.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I have sent at "send mail" icon at your web site & attached all
three documents have you received the same.

Sir, If you have not received with your due permission can I have
your email address...

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Graham Mayor wrote:
OK I'll wait to see what turns up.


Bhavana wrote:
Sir,

I shall send you all the three documents. Sir, I am removing
all Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as
you described them. The macro code is quite specific. Without
the original documents, I would be fishing in the dark to
correct it. Are you able to send me the thee documents? If so,
zip them up and send them to the link on the home page of my
web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is
working fine but at the end all the six final documents
created by system goes blank.



You will get an error unless you change the path to where you
have stored the three documents and unless the documents are
named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum
editor the line should actually read

Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the
following will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored
the 3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file
not found. I have saved all the three original files as per
given path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are
named with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary
changes. The original documents are not affected and the
macro finishes with the six documents open.
The code can undoubtedly be simplified if you want to put
the time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With

 

[Bhavana]

Thank you sir,

It is working. I have saved 3rd set of question set in 2007 version and
other two in 2003 hence did not work. But now it is working. Thanks for
timely help & kind support.

--
tks

bhavana

Sir,

I have changed the subject both the times when I have sent it before...

Resent as advised by you,

bhavana
--
tks

bhavana

I have not to date received the documents. The e-mail address is support AT
gmayor.com replace ' AT ' with @.
The link on the home page of my web site www.gmayor.com will create a
message with this address pre-inserted. DO NOT change the subject or it may
be treated as spam. If your documents are large, your e-mail system may not
allow them to be sent as attachments. Use a compression tool like WinZip or
WinRar to reduce their size and maybe send as three separate messages.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Sir,

I have sent at "send mail" icon at your web site & attached all three
documents have you received the same.

Sir, If you have not received with your due permission can I have
your email address...

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Graham Mayor wrote:
OK I'll wait to see what turns up.


Bhavana wrote:
Sir,

I shall send you all the three documents. Sir, I am removing all
Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite as
you described them. The macro code is quite specific. Without the
original documents, I would be fishing in the dark to correct it.
Are you able to send me the thee documents? If so, zip them up and
send them to the link on the home page of my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is working
fine but at the end all the six final documents created by system
goes blank.



You will get an error unless you change the path to where you
have stored the three documents and unless the documents are
named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum editor
the line should actually read

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the following
will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored the
3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file not
found. I have saved all the three original files as per given
path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My Documents\Test\Versions\Even\Q
Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are named
with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary
changes. The original documents are not affected and the
macro finishes with the six documents open.
The code can undoubtedly be simplified if you want to put the
time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1

 

[Graham Mayor]

You are welcome

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Thank you sir,

It is working. I have saved 3rd set of question set in 2007 version
and other two in 2003 hence did not work. But now it is working.
Thanks for timely help & kind support.

Sir,

I have changed the subject both the times when I have sent it
before...

Resent as advised by you,

bhavana
--
tks

bhavana

I have not to date received the documents. The e-mail address is
support AT gmayor.com replace ' AT ' with @.
The link on the home page of my web site www.gmayor.com will create
a message with this address pre-inserted. DO NOT change the subject
or it may be treated as spam. If your documents are large, your
e-mail system may not allow them to be sent as attachments. Use a
compression tool like WinZip or WinRar to reduce their size and
maybe send as three separate messages.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>



Bhavana wrote:
Sir,

I have sent at "send mail" icon at your web site & attached all
three documents have you received the same.

Sir, If you have not received with your due permission can I have
your email address...

bhavana

Did you send them yet? Nothing received here

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Graham Mayor wrote:
OK I'll wait to see what turns up.


Bhavana wrote:
Sir,

I shall send you all the three documents. Sir, I am removing
all Serial nos. of question nos. I don't need it.

tks

That suggests that the three original documents are not quite
as you described them. The macro code is quite specific.
Without the original documents, I would be fishing in the dark
to correct it. Are you able to send me the thee documents? If
so, zip them up and send them to the link on the home page of
my web site.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Sir,

As advised by you I have made necessary changes. code is
working fine but at the end all the six final documents
created by system goes blank.



You will get an error unless you change the path to where you
have stored the three documents and unless the documents are
named "Q Set
1.docx", "Q Set 2.docx" and "Q Set 3.docx" as I explained!

Howeevr thanks to premature wrapping of the line in forum
editor the line should actually read

Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set" & i & ".docx")

as this will probably wrap incorrectly too, maybe the
following will help

Set QDoc = Documents.Open("D:\Path\Q Set " & i & ".docx")

D:\Path should be changed to the path where you have stored
the 3 documents.


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Bhavana wrote:
Thank you sir for your prompt response.

I am getting runtime error 5174 that at the given path file
not found. I have saved all the three original files as
per given path. Am I suppose to give question set no.

Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")

Sir where I am going wrong ??


The following macro should do what you ask, provided your 3
documents are laid out as you indicated.
The macro assumes that the three original documents are
named with the number being used to select the document
Q Set 1.docx
Q Set 2.docx
Q Set 3.docx
and the path used is "D:\My Documents\Test\Versions\Even\"
It will also work with doc format as long as you change the
extension in the line
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
The macro produces 6 question papers named Test1 to 6.docx
again you can use doc format if you make the necessary
changes. The original documents are not affected and the
macro finishes with the six documents open.
The code can undoubtedly be simplified if you want to put
the time into doing so, but it works as is.

Sub CreateQuestionsPapers()
Dim QDoc As Document
Dim TDoc1 As Document
Dim TDoc2 As Document
Dim TDoc3 As Document
Dim TDoc4 As Document
Dim TDoc5 As Document
Dim TDoc6 As Document
Dim oRng As Range
Dim qRng As Range
Dim QNum As Long
Dim Count As Long
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set TDoc1 = Documents.Add
Set TDoc2 = Documents.Add
Set TDoc3 = Documents.Add
Set TDoc4 = Documents.Add
Set TDoc5 = Documents.Add
Set TDoc6 = Documents.Add
Dim NewDocs As Variant

For i = 3 To 1 Step -1
Count = 0
Set QDoc = Documents.Open("D:\My
Documents\Test\Versions\Even\Q Set " _ & i & ".docx")
With Selection
.EndKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:="Q.*", _
MatchWildcards:=True, _
Forward:=False)
Set oRng = Selection.Range
Count = Count + 1
Select Case Count
Case Is = 1, 2, 3, 4, 5
TDoc6.Range.InsertBefore oRng
Case Is = 6, 7, 8, 9, 10
TDoc5.Range.InsertBefore oRng
Case Is = 11, 12, 13, 14, 15
TDoc4.Range.InsertBefore oRng
Case Is = 16, 17, 18, 19, 20
TDoc3.Range.InsertBefore oRng
Case Is = 21, 22, 23, 24, 25
TDoc2.Range.InsertBefore oRng
Case Is = 26, 27, 28, 29, 30
TDoc1.Range.InsertBefore oRng
End Select
oRng.Collapse wdCollapseStart
Wend
End With
End With
QDoc.Close wdDoNotSaveChanges
Next i
With TDoc6
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test6.docx"
End With
With TDoc5
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test5.docx"
End With
With TDoc4
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test4.docx"
End With
With TDoc3
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test3.docx"
End With
With TDoc2
.Activate
With Selection
.HomeKey wdStory
QNum = 0
While .Find.Execute("Q.[0-9]{1,2}", _
Replacewith:="Q.", _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop)
QNum = QNum + 1
Set qRng = Selection.Range
qRng.InsertAfter QNum & " "
Selection.Collapse wdCollapseEnd
Wend
End With
.SaveAs "Test2.docx"
End With
With TDoc1