CODEWITHSUNDEEP
vbaexcel
user4946547
user4946547

Reputation:

Paste multiple sheets into a single Word document

I'm trying to copy and paste each worksheet in a workbook onto a new sheet in a single Word document. Unfortunately it is only copying the contents of the first worksheet, though it does seem to be looping through all the worksheets. I thought that inserting a page break would work but it isn't. It also won't let me format it in Word. I want the contents of A1 to have a header style.

This is my code:

Sub ExceltoWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

For Each ws In Wkbk1.Worksheets
Wkbk1.ActiveSheet.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
'file name & folder path
Dim strdocname As String
  On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Err.Clear
'create new instance of word application
    Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "P:\ImportedDescriptions.doc"
If Dir(strdocname) = "" Then
    MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "P:\ImportedDescriptions.doc", vbExclamation, "The document does not exist "
    Exit Sub
End If

wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)

Set Header = Range("A1")
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Selection.WholeStory
Header.Style = ActiveDocument.Styles("Heading 2")
Selection.InsertBreak Type:=wdPageBreak
Next ws
wddoc.Save
'wdapp.Quit

Set wddoc = Nothing
Set wdapp = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Upvotes: 0

Views: 2100

Answers (2)

daytonrazorback
daytonrazorback

Reputation: 235

You are only copying from the active worksheet, which happens to be the first sheet in your case. Instead of:

For Each ws In ActiveWorkbook.Worksheets
ActiveWorkbook.ActiveSheet.Range("A1:A2").Copy

use:

For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy

This will copy each range in turn.

Upvotes: 1

user4691433
user4691433

Reputation:

I think it is losing track of which workbook you started with when you activate Word. Save your workbook to a Workbook variable (i.e. Dim Wkbk1 As Workbook, Set Wkbk1 = ActiveWorkbook) then replace every instance of ActiveWorkbook in your code after that with Wkbk1 (in your For Each loop and every time you want to reference it inside the loop as well).

Upvotes: 0

Related Questions