Try something along the lines of:
Code:
Sub Export_Click()
Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook, r As Long
Dim xlWkSht1 As Excel.Worksheet, xlWkSht2 As Excel.Worksheet, x As Long
With xlApp
'Hide our Excel session
.Visible = True 'False
'Open the workbook
Set xlWkBk = .Workbooks.Open("C:\Users\nithomas\OneDrive - UNCG\Autofill Database Test 4.xlsx", AddToMRU:=False)
Set xlWkSht1 = xlWkBk.Sheets("Master Database")
'Find the next available row
r = xlWkSht1.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
'Do set-up for secondary sheet
Select Case ActiveDocument.SelectContentControlsByTitle("PID Concentration")(1).Range.Text
Case "K-12 Deaf and Hard of Hearing Teaching Licensure"
Set xlWkSht2 = xlWkBk.Sheets("Deaf and Hard of Hearing")
'Find the next available row
x = xlWkSht2.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Case "Advocacy and Services for the Deaf"
Set xlWkSht2 = xlWkBk.Sheets("Advocacy and Services")
'Find the next available row
x = xlWkSht2.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Case "Interpreter Preparation"
Set xlWkSht2 = xlWkBk.Sheets("Interpreter Preparation")
'Find the next available row
x = xlWkSht2.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Case Else: Set xlWkSht2 = Nothing
End Select
'Update the workbook
With ActiveDocument
xlWkSht1.Range("B" & r).Value = .SelectContentControlsByTitle("Student Name")(1).Range.Text
xlWkSht1.Range("C" & r).Value = .SelectContentControlsByTitle("PID Concentration")(1).Range.Text
xlWkSht1.Range("D" & r).Value = .SelectContentControlsByTitle("Second Degree")(1).Range.Text
xlWkSht1.Range("E" & r).Value = .SelectContentControlsByTitle("First Degree")(1).Range.Text
xlWkSht1.Range("F" & r).Value = .SelectContentControlsByTitle("Associates of Arts")(1).Range.Text
xlWkSht1.Range("G" & r).Value = .SelectContentControlsByTitle("Associates of Applied Science")(1).Range.Text
xlWkSht1.Range("H" & r).Value = .SelectContentControlsByTitle("Bachelor of Arts")(1).Range.Text
xlWkSht1.Range("I" & r).Value = .SelectContentControlsByTitle("Master of Arts")(1).Range.Text
xlWkSht1.Range("J" & r).Value = .SelectContentControlsByTitle("Doctor of Philosophy")(1).Range.Text
xlWkSht1.Range("K" & r).Value = .SelectContentControlsByTitle("Other")(1).Range.Text
If Not xlWkSht2 Is Nothing Then
'do whatever output is required for the secondary sheet. For example:
xlWkSht2.Range("B" & x).Value = .SelectContentControlsByTitle("Student Name")(1).Range.Text
xlWkSht2.Range("C" & x).Value = .SelectContentControlsByTitle("Second Degree")(1).Range.Text
End If
End With
' Save & Close the Excel workbook
xlWkBk.Close SaveChanges:=True
.Quit
End With
' Release object memory
Set xlWkSht1 = Nothing: Set xlWkSht2 = Nothing: Set xlWkBk = Nothing: Set xlApp = Nothing
' Tell the user we're done.
MsgBox "Workbook updates finished.", vbOKOnly
End Sub