Sub Create_Contact_Log()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Set wdDoc = Documents.Add(Template:=ActiveWorkbook.Path & "\Contact_Log.dotx")
Dim ws As Worksheet, i As Long: i = 0
Dim month As String: month = ActiveWorkbook.Worksheets("SET DATE").Range("C1")
Dim year As String: year = ActiveWorkbook.Worksheets("SET DATE").Range("E1")

For Each ws In ActiveWorkbook.Worksheets
    Select Case ws.Name
      Case "SET DATE", "Crisis Schedule", "STATS", "ACTT Staff - Contact Numbers", "TCL Housing Status", "Client Address List", "ITT", "KPI", "HOSPITALIZATIONS", "OFFICE DATA ENTRY", "Contact Log", "TOP", "BOTTOM"
      Case Else
        i = i + 1
        With wdDoc
          If i > 1 Then
            .Range.Sections.Add Range:=.Range.Characters.Last, Start:=wdSectionNewPage
            .Range.Characters.Last.FormattedText = .AttachedTemplate.Range.FormattedText
          End If
          With .Sections.Last.Range
            .Paragraphs(1).Range.InsertBefore month & " " & year
            .Paragraphs(2).Range.Characters.Last.InsertBefore ws.Range("A35")
            With .Tables(1).Range
              .Cells(2).Range.Text = ws.Range("A26")
              .Cells(4).Range.Text = ws.Range("B30")
              .Cells(6).Range.Text = ws.Range("B26")
              .Cells(8).Range.Text = ws.Range("B28")
              .Cells(10).Range.Text = ws.Range("C28")
            End With
          End With
        End With
    End Select
Next
wdApp.Visible = True
End Sub