Sub Courses()
Dim LRow As Long
Dim Found As Range

With Sheets("Sheet1")
  Set Found = .Range("A1:AB1").Find("coursename", LookIn:=xlValues, lookat:=xlWhole, searchformat:=False)
  If Not Found Is Nothing Then
    Set FirstFound = Found
    Do
      LRow = .Cells(.Rows.Count, Found.Column).End(xlUp).Row
      .Range(.Cells(2, Found.Column), .Cells(LRow, Found.Column)).Copy
      .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Set Found = .Range("A1:AB1").Find(what:="coursename", after:=Found, LookIn:=xlValues, lookat:=xlWhole, searchformat:=False)
    Loop Until Found Is Nothing Or Found.Address = FirstFound.Address
  End If
End With
End Sub