Add to Macro - Move additional Text from Excel to Word doc

[mstuf]

Hello - Thank you for looking. I have a Working Macro that has saved

me countless time with increased data accuracy across the last years that was created with Help of others more knowledgable than I. I am using - Windows XP SP3 & Office XP and 2003.

I would like to add a feature to this Macro that will add info to the

end product making it more useable and again saving time.

My Macro cuts one designated row from One Workbook and Places it in

Another at the next available row position. It then copies a specified cell and places the text in a Named Open Word Document at the position of the cursor.

I would like to Copy text from three additional Cells of that same

last row and place them in another spot in the Open Word Document. The additional text would all be placed on one line with space dash space between them/ The last row is currently left highlighted.

Im envisioning that leaving the current macro as is and adding code to the end to return to the highlighted row to copy the cells I need and then pasting them into the word document.

I'm puzzled as to how to specify the location that I want the

Additional text copied to. My thoughts say that the current code could be modified to leave the cursor at the desired position ( its not the position of the previous paste ) - but unsure how to do that. OR, designating the position for the paste to be the first row after any row containing 6 or more dashes. ( -------- )

The Text would be in Cells S , AQ and AO of the last ( just

transfered ) row of the Excel Workbook Named AMZ-GM Sold.xls.

Here is my Current Code.

Sub OpenToSold()
' OpentoSold Macro Moves Sold Items from Amz Open to Sold and Pastes _
  the Description at the Cursor in the open AmazonSale Word Doc.

   'Macro recorded 2/1/2008 by Mike

   ' Keyboard Shortcut: Ctrl+Shift+W

Dim lRow As Long
Dim lCol As Long
Rows(ActiveCell.Row).Cut
Windows("AMZ-GM Sold.xls").Activate
lRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row 'This gets the last row from AMZ-GM Sold.xls
ActiveSheet.Cells(lRow + 1, 1).Activate 'Add 1 to the last row for first blank row
ActiveSheet.Paste
Cells(ActiveCell.Row, 26).Copy ' Copy Z--- 26 = z



Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Set WDApp = GetObject(, "Word.Application") ' Reference active document
Set WDDoc = WDApp.ActiveDocument
WDApp.Selection.PasteSpecial
WDApp.Visible = True 'This should leave Word Open
' Clean up
Set WDDoc = Nothing
Set WDApp = Nothing
Application.WindowState = xlMinimized
End Sub

I'm getting better at editing my macros but still having tough time with specifying variables / location. There does not seem to be the pleathra of info for word VBA as there is for Excel.

Any Ideas or Help much appreciated. Thank You

 

[mstuf]

With that change, the code in post #16 should work.

Same 438 Error Message -

Its 3:30 AM Here -- First Night Home -- I'm hitting the bed for tonight but back at it tomorrow --

Thanks For Looking again

 

[mstuf]

Paul - I want to thank you so much - I have made something work. It may not be the best way but it works. I'm so pleased.
During the Process I learned about Bookmarks - Using Find Via VBA - Execute - EndKey and more that I had not used before.
I will be able to use bookmark in another application that will save much time.
Best part is, I think I understand everything but "Set" - Still working on that.
Never could get past that 438 Error message with your direction so I proceeded with my probably improper idea and have made it work. Also learned a lot about re arranging text in Word with VBA.

Heres what I arrived at - for anyone following who is interested.

Sub OpenToSold5()

Dim lRow As Long
Dim lCol As Long
Rows(ActiveCell.Row).Cut
Windows("AMZ-GM Sold.xls").Activate
lRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row 
ActiveSheet.Cells(lRow + 1, 1).Activate 
ActiveSheet.Paste
Cells(ActiveCell.Row, 26).Copy ' Copy Z--- 26 = z


Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Set WDApp = GetObject(, "Word.Application") ' Reference active document
Set WDDoc = WDApp.ActiveDocument
WDApp.Selection.PasteSpecial
   
WDApp.Visible = True 

With WDApp.Selection.Find
    .Text = "------"
           .Execute
End With

WDApp.Selection.MoveDown Unit:=wdLine, Count:=1

Windows("AMZ-GM Sold.xls").Activate
Cells(ActiveCell.Row, 19).Copy

WDApp.Selection.PasteSpecial
WDApp.Visible = True

WDApp.Selection.MoveUp Unit:=wdLine, Count:=1
WDApp.Selection.EndKey Unit:=wdLine
WDApp.Selection.TypeText Text:="   -   "

Windows("AMZ-GM Sold.xls").Activate
Cells(ActiveCell.Row, 43).Copy

WDApp.Selection.PasteSpecial
WDApp.Visible = True

WDApp.Selection.TypeText Text:="   -   "

Windows("AMZ-GM Sold.xls").Activate
Cells(ActiveCell.Row, 41).Copy

WDApp.Selection.PasteSpecial
WDApp.Visible = True 

' Clean up
Set WDDoc = Nothing
Set WDApp = Nothing
Application.WindowState = xlMinimized

End Sub

My Document appears ready to print with my 3 extra pieces of information included where I wanted them.

Again thanks so much for taking this on -- I know that not a lot of folks understand Combined Excel Word Macros. Very Nice of you to share your knowledge.