Excel 2007 : Converting multiple columns to multiple rows

[danegod]

I've been banging my head on this for a few days now. I've searched high and low across the forums, but can't seem to find a macro to get this accomplished. I'm a maintenance worker, so I'm not very comprehensive when it comes to Excel. I need a way to transpose multiple rows containing many columned dates into many many more rows. Attached is an example of what I am going for.

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim lastrow As Long
Dim numitems As Long
Dim nextrow As Long
Dim i As Long, j As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        Set sh = Worksheets.Add
        sh.Name = "Transposed Data"
        sh.Range("A1").Value2 = .Range("A1").Value2
        sh.Range("A1:D1").Merge
        sh.Range("A2:D2").Value = Array("Shop", "User", "Course Due Date", "Course Name")
        nextrow = 3
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 4 To lastrow 'Lastrow to 1 Step
        
            numitems = .Cells(i, .Columns.Count).End(xlToLeft).Column - 2
            sh.Cells(nextrow, "A").Resize(numitems).Value = .Cells(i, "A").Value2
            sh.Cells(nextrow, "B").Resize(numitems).Value = .Cells(i, "B").Value2
            For j = 1 To numitems
            
                sh.Cells(nextrow + j - 1, "C").Value = .Cells(i, j + 2).Value
                sh.Cells(nextrow + j - 1, "D").Value = .Cells(2, j + 2).Text
            Next j
            nextrow = nextrow + numitems
        Next i
        
        sh.Columns("A").ColumnWidth = 6
        sh.Columns("B").ColumnWidth = 28
        sh.Columns("C").ColumnWidth = 12
        sh.Columns("D").ColumnWidth = 24
        sh.Columns("A:D").HorizontalAlignment = xlCenter
    End With
    
    Application.ScreenUpdating = True
End Sub

[danegod]

Thanks a ton!