Looking for way to extract data from Excel sheet and place into new sheet

You're welcomejaydub66!

Yes, you did it correctly.

Considering the name of the data sheet is not fixed, you may either use the Sheet CodeName or the Sheet Index which would be 1 as there would only be one worksheet in the Workbook.

Also, you may use the Column Letter to decide the first name header and the last name header in the data set.

Please try this tweaked code and let me know if that works well on your end...

Sub GetUniqueCoachNames()
Dim wsData      As Worksheet
Dim wsReport    As Worksheet
Dim lr          As Long
Dim col         As Long
Dim i           As Long
Dim j           As Long
Dim arr         As Variant
Dim arrOut()    As Variant
Dim dict        As Object
Dim it          As Variant
Dim StartCol    As String
Dim EndCol      As String

Application.ScreenUpdating = False

Set wsData = Sheet1   'Using the Sheet CodeName of the only Sheet in the Workbook

'OR use the Sheet Index to set the only Sheet in the workbook like this
'Uncomment the below line by removing the single quote in the beginning if the above line doesn't work for you
'Set wsData = ThisWorkbook.Worksheets(1)


'Using Column Letter to decide the first Coach Name header and the last Coach Name header
StartCol = "A1"
EndCol = "D1"

On Error Resume Next
Set wsReport = Worksheets("Unique Coach Names")     'Name of Sheet with unique coach names that would be inserted
wsReport.Range("A1").CurrentRegion.Offset(1).Clear
On Error GoTo 0

If wsReport Is Nothing Then
    Set wsReport = Worksheets.Add(after:=wsData)
    wsReport.Name = "Unique Coach Names"
    With wsReport.Range("A1:C1")
        .Value = Array("Coach Name", "Coach Email", "Coach Phone")
        .Borders.Color = vbBlack
        .Font.Size = 12
        .Font.Bold = True
    End With
End If

lr = wsData.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Set dict = CreateObject("Scripting.Dictionary")

For col = Range(StartCol).Column To Range(EndCol).Column Step 3
    arr = wsData.Range(wsData.Cells(2, col), wsData.Cells(lr, col + 2)).Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> "" Then
            dict.Item(arr(i, 1) & "^" & arr(i, 2) & "^" & arr(i, 3)) = ""
        End If
    Next i
Next col

ReDim arrOut(1 To dict.Count, 1 To 3)

For Each it In dict.keys
    j = j + 1
    arrOut(j, 1) = Split(it, "^")(0)
    arrOut(j, 2) = Split(it, "^")(1)
    arrOut(j, 3) = Split(it, "^")(2)
Next it

With wsReport.Range("A2").Resize(j, 3)
    .Value = arrOut
    .Borders.Color = vbBlack
End With

wsReport.Select
wsReport.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True

End Sub