Macro to Copy from worksheet and paste to Word Document

Posted by Marc Hennebery on December 07, 2000 7:40 PM

I have a Worksheet that contains 1 record per row. The fields can range from a minimum of A thru K to a Maximum of A thru S. What I am trying to do is copy the fields to a template worksheet, one record at a time, then select the template and copy and paste it to Word. Each record would be a separate table in a Word document. My problem is how to check for data in columns K thru S, and if they are empty, not copy and not paste to Word so that I don't end up with a table with a bunch of empty cells. this is the Macro I am using:

Sub Greenbriar1()
' You must pick Microsoft Word 8.0 from Tools>References
' in the VB editor to execute Word commands.
' See VB Help topic "Controlling One Microsoft Office Application from Another"
' for more information.
' Macro created by Marc F. Hennebery 11/25/2000

Dim appWD As Word.Application

' Create a new instance of Word & make it visible
Set appWD = CreateObject("Word.Application.8")
appWD.Visible = True

Sheets("Drug Regimen").Select
'Find the last row with data in the database
FinalRow = Range("A9999").End(xlUp).Row
' Tell Word to create a new document
appWD.Documents.Open ("I:\Medistat\Greenbriar Station 1 Summary.doc")
For i = 2 To FinalRow
Sheets("Drug Regimen").Select
' Copy the name to cell B2
Range("A" & i).Copy Destination:=Sheets("Template").Range("B2")
Sheets("Drug Regimen").Select
Range("B" & i).Copy Destination:=Sheets("Template").Range("D2")
Sheets("Drug Regimen").Select
Range("C" & i).Copy Destination:=Sheets("Template").Range("F2")
Sheets("Drug Regimen").Select
Range("D" & i).Copy Destination:=Sheets("Template").Range("F4")
Sheets("Drug Regimen").Select
Range("E" & i).Copy Destination:=Sheets("Template").Range("D3")
Sheets("Drug Regimen").Select
Range("F" & i).Copy Destination:=Sheets("Template").Range("B4")
Sheets("Drug Regimen").Select
Range("G" & i).Copy Destination:=Sheets("Template").Range("B3")
Sheets("Drug Regimen").Select
Range("H" & i).Copy Destination:=Sheets("Template").Range("F3")
Sheets("Drug Regimen").Select
Range("I" & i).Copy Destination:=Sheets("Template").Range("D4")
Sheets("Drug Regimen").Select
Range("K" & i).Copy Destination:=Sheets("Template").Range("A6")
Sheets("Drug Regimen").Select
Range("L" & i).Copy Destination:=Sheets("Template").Range("A7")
Sheets("Drug Regimen").Select
Range("M" & i).Copy Destination:=Sheets("Template").Range("A8")
Sheets("Drug Regimen").Select
Range("N" & i).Copy Destination:=Sheets("Template").Range("A9")
Sheets("Drug Regimen").Select
Range("O" & i).Copy Destination:=Sheets("Template").Range("A10")
Sheets("Drug Regimen").Select
Range("P" & i).Copy Destination:=Sheets("Template").Range("A11")
Sheets("Drug Regimen").Select
Range("Q" & i).Copy Destination:=Sheets("Template").Range("A12")
Sheets("Drug Regimen").Select
Range("R" & i).Copy Destination:=Sheets("Template").Range("A13")
Sheets("Drug Regimen").Select
Range("S" & i).Copy Destination:=Sheets("Template").Range("A14")

' Copy the data for the new document to the clipboard
Sheets("Template").Select
Range("A2:F14").Copy
' Tell Word to paste the contents of the clipboard into the new document
appWD.Selection.Paste
' Close this new word document
appWD.Selection.TypeText Text:=vbTab
appWD.Selection.TypeParagraph
Next i
Sheets("Drug Regimen").Select
appWD.ActiveDocument.SaveAs FileName:="I:\Medistat\Greenbriar Station 1 Summary " & Date$
appWD.ActiveDocument.Close

' Close the Word application
appWD.Quit

End Sub

Posted by Celia on December 07, 2000 11:22 PM

Sheets("Drug Regimen").Select 'Find the last row with data in the database FinalRow = Range("A9999").End(xlUp).Row ' Tell Word to create a new document appWD.Documents.Open ("I:\Medistat\Greenbriar Station 1 Summary.doc") For i = 2 To FinalRow Sheets("Drug Regimen").Select ' Copy the name to cell B2 Range("A" & i).Copy Destination:=Sheets("Template").Range("B2") Sheets("Drug Regimen").Select Range("B" & i).Copy Destination:=Sheets("Template").Range("D2") Sheets("Drug Regimen").Select Range("C" & i).Copy Destination:=Sheets("Template").Range("F2") Sheets("Drug Regimen").Select Range("D" & i).Copy Destination:=Sheets("Template").Range("F4") Sheets("Drug Regimen").Select Range("E" & i).Copy Destination:=Sheets("Template").Range("D3") Sheets("Drug Regimen").Select Range("F" & i).Copy Destination:=Sheets("Template").Range("B4") Sheets("Drug Regimen").Select Range("G" & i).Copy Destination:=Sheets("Template").Range("B3") Sheets("Drug Regimen").Select Range("H" & i).Copy Destination:=Sheets("Template").Range("F3") Sheets("Drug Regimen").Select Range("I" & i).Copy Destination:=Sheets("Template").Range("D4") Sheets("Drug Regimen").Select Range("K" & i).Copy Destination:=Sheets("Template").Range("A6") Sheets("Drug Regimen").Select Range("L" & i).Copy Destination:=Sheets("Template").Range("A7") Sheets("Drug Regimen").Select Range("M" & i).Copy Destination:=Sheets("Template").Range("A8") Sheets("Drug Regimen").Select Range("N" & i).Copy Destination:=Sheets("Template").Range("A9") Sheets("Drug Regimen").Select Range("O" & i).Copy Destination:=Sheets("Template").Range("A10") Sheets("Drug Regimen").Select Range("P" & i).Copy Destination:=Sheets("Template").Range("A11") Sheets("Drug Regimen").Select Range("Q" & i).Copy Destination:=Sheets("Template").Range("A12") Sheets("Drug Regimen").Select Range("R" & i).Copy Destination:=Sheets("Template").Range("A13") Sheets("Drug Regimen").Select Range("S" & i).Copy Destination:=Sheets("Template").Range("A14") ' Copy the data for the new document to the clipboard Sheets("Template").Select Range("A2:F14").Copy ' Tell Word to paste the contents of the clipboard into the new document appWD.Selection.Paste ' Close this new word document appWD.Selection.TypeText Text:=vbTab appWD.Selection.TypeParagraph Next i Sheets("Drug Regimen").Select appWD.ActiveDocument.SaveAs FileName:="I:\Medistat\Greenbriar Station 1 Summary " & Date$ appWD.ActiveDocument.Close appWD.Quit

Marc
Try the following code for the copy/paste thing :-

With ThisWorkbook.Sheets("Drug Regimen")
'Find the last row with data in the database
FinalRow = .Range("A9999").End(xlUp).Row
' Copy/paste to "Template" sheet
For i = 2 To FinalRow
.Range("A" & i).Copy Destination:=Sheets("Template").Range("B2")
.Range("B" & i).Copy Destination:=Sheets("Template").Range("D2")
.Range("C" & i).Copy Destination:=Sheets("Template").Range("F2")
.Range("D" & i).Copy Destination:=Sheets("Template").Range("F4")
.Range("E" & i).Copy Destination:=Sheets("Template").Range("D3")
.Range("F" & i).Copy Destination:=Sheets("Template").Range("B4")
.Range("G" & i).Copy Destination:=Sheets("Template").Range("B3")
.Range("H" & i).Copy Destination:=Sheets("Template").Range("F3")
.Range("I" & i).Copy Destination:=Sheets("Template").Range("D4")
.Range(.Range("K" & i), .Range("S" & i)).Copy
With ThisWorkbook.Sheets("Template")
.Range("A6").PasteSpecial Paste:=xlAll, Transpose:=True
' Copy the data for the new document to the clipboard
c = .Range("A9999").End(xlUp).Row
.Range(.Range("A2"), .Range("F" & c)).Copy
End With
'Your paste code here
Next
End With

Celia

Posted by Celia on December 07, 2000 11:26 PM

Post script

I have assumed that any data in columns K to S would be contiguous starting from column K.
Post again if this is not the case.
Celia

Posted by Marc Hennebery on December 08, 2000 1:27 AM

Re: Thanks for your help ....

K Thru S was contiguous, and it worked like a charm. Thank you for your help.

By the way, could this be modified to append the data from Worksheet "Drug Regimen" to another Worksheet "Regimen Archive"? Or is there a better method? When the Word reports are completed, printed, and verified, I owuld like a macro to copy all the reported data and append to this other sheet. I apologize, but I am a novice at this, as you can probably tell from my macro. The archive sheet is an exact copy of "Drug Regimen". No formatting of cells or anything.

Posted by Celia on December 08, 2000 2:29 AM

Re: Thanks for your help ....

Marc
Try this :-

Sub Paste_to_Archive()
With Sheets("Drug Regimen")
r = .Range("A9999").End(xlUp).Row
.Range(.Range("A2"), .Range("S" & r)).Copy
End With
With Sheets("Regimen Archive")
If .Range("A2") = "" Then
.Paste Destination:=.Range("A2")
Else
.Paste Destination:=.Range("A9999").End(xlUp).Offset(1, 0)
End If
End With
Application.CutCopyMode = False
End Sub

If you also want to clear the data from "Drug Regimen" then add this code at the end :-
Sheets("Drug Regimen").Activate
Range(Range("A2"), Range("S" & r)).ClearContents

Celia

Posted by Marc Hennebery on December 08, 2000 7:00 AM

Re: Thanks again for your help ....

Once again, right on the money. Worked like a charm. Thanks a million for your help.