Paste multiple sheets into a single Word document - vba

Question

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

Answer 1

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.

Answer 2

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).