Wolf80
11-05-2012, 11:04 AM
Hello all,
First of all thanks to everyone on here I have been using this site lots to develop various codes and it has been really helpful.
I have made some code to copy a selected range from a worksheet in excel and then paste it to a bookmark in word.
This works fine for one worksheet and bookmark but I know need to cycle it through a further 20 worksheets and bookmarks to complete the cycle and fill the word file.
Unfortunately the only way I seem to be able to do this at the moment is basically copying the code 20 times and make slight changes. obviously this is quite untidy. Has anyone some ideas how I could tidy it up.
I have included the base code as an example you will probably recongise a fair bit from other posts.
Sub Copyfrom()
Dim LR As Long, LC As Long, cell As Range, rng As Range
Dim appWrd As Object
Dim objDoc As Object
Dim FilePath As String
Dim FileName As String
Dim LastRow As Long
Dim Prompt As String
Const wdGoToBookmark As Long = -1
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Assign the Word file path and name to variables
FilePath = "XXX"
FileName = "Trial.doc"
Workbooks.Open FileName:="XXX.xls"
Set sourceSheet = Worksheets("E.1")
sourceSheet.Activate
LastCol = ActiveSheet.Range("q3").End(xlToRight).Column
LastRow = ActiveSheet.Range("q3").End(xlDown).Row
ActiveSheet.Range("q3:" & _
ActiveSheet.Cells(LastRow, LastCol).Address).Copy
'Assign the Word file path and name to variables
FilePath = "XXX"
FileName = "Trial.doc"
'Create an instance of Word for us to use
Set appWrd = CreateObject("Word.Application")
'Open our specified Word file, On Error is used in case the file is not there
On Error Resume Next
Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
On Error GoTo 0
'If the file is not found, we need to end the sub and let the user know
If objDoc Is Nothing Then
MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
appWrd.Quit
Set appWrd = Nothing
Exit Sub
End If
'Word to goto the bookmark assigned to the variable BookMarkRange
appWrd.Selection.Goto What:=wdGoToBookmark, Name:="Text1"
Application.SendKeys ("^v")
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
First of all thanks to everyone on here I have been using this site lots to develop various codes and it has been really helpful.
I have made some code to copy a selected range from a worksheet in excel and then paste it to a bookmark in word.
This works fine for one worksheet and bookmark but I know need to cycle it through a further 20 worksheets and bookmarks to complete the cycle and fill the word file.
Unfortunately the only way I seem to be able to do this at the moment is basically copying the code 20 times and make slight changes. obviously this is quite untidy. Has anyone some ideas how I could tidy it up.
I have included the base code as an example you will probably recongise a fair bit from other posts.
Sub Copyfrom()
Dim LR As Long, LC As Long, cell As Range, rng As Range
Dim appWrd As Object
Dim objDoc As Object
Dim FilePath As String
Dim FileName As String
Dim LastRow As Long
Dim Prompt As String
Const wdGoToBookmark As Long = -1
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Assign the Word file path and name to variables
FilePath = "XXX"
FileName = "Trial.doc"
Workbooks.Open FileName:="XXX.xls"
Set sourceSheet = Worksheets("E.1")
sourceSheet.Activate
LastCol = ActiveSheet.Range("q3").End(xlToRight).Column
LastRow = ActiveSheet.Range("q3").End(xlDown).Row
ActiveSheet.Range("q3:" & _
ActiveSheet.Cells(LastRow, LastCol).Address).Copy
'Assign the Word file path and name to variables
FilePath = "XXX"
FileName = "Trial.doc"
'Create an instance of Word for us to use
Set appWrd = CreateObject("Word.Application")
'Open our specified Word file, On Error is used in case the file is not there
On Error Resume Next
Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
On Error GoTo 0
'If the file is not found, we need to end the sub and let the user know
If objDoc Is Nothing Then
MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
appWrd.Quit
Set appWrd = Nothing
Exit Sub
End If
'Word to goto the bookmark assigned to the variable BookMarkRange
appWrd.Selection.Goto What:=wdGoToBookmark, Name:="Text1"
Application.SendKeys ("^v")
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub