Option Explicit

Sub toWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Dim wdapp As Object
Dim wddoc As Object
Dim orng As Object
Dim strdocname As String

    Set Wkbk1 = ActiveWorkbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    strdocname = "C:\Name.doc"


    'file name & folder path
    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
    If Dir(strdocname) = "" Then
        'MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Path\Name.doc", _
         '       vbExclamation, "The document does not exist "
        'Exit Sub
        Set wddoc = wdapp.Documents.Add
    Else
        Set wddoc = wdapp.Documents.Open(strdocname)
    End If
    For Each ws In ActiveWorkbook.Worksheets
        ws.Range("A1:A2").Copy
        Set orng = wddoc.Range
        orng.collapse 0
        orng.Paste
        orng.End = wddoc.Range.End
        orng.collapse 0
        orng.insertbreak 7
    Next ws

lbl_Exit:
    Set orng = Nothing
    Set wddoc = Nothing
    Set wdapp = Nothing
    Set Wkbk1 = Nothing
    Set ws = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Exit Sub
End Sub