Assuming for now two sheets in the workbook.... DATA with the raw data and OUTPUT to write the new table into:
Option Explicit
Sub ReformatClassInfo()
Dim arrDATA As Variant, arrOUT As Variant
Dim LR As Long, r As Long, c As Long, NR As Long
With Sheets("Data")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim arrDATA(1 To LR, 1 To 7)
arrDATA = .Range("A1:G" & LR).Value
End With
ReDim arrOUT(1 To LR * 9, 1 To 2)
NR = 1
For r = 1 To LR
arrOUT(NR, 1) = "Subject"
arrOUT(NR + 1, 1) = "German"
arrOUT(NR + 2, 1) = "English"
arrOUT(NR + 3, 1) = "The Term"
arrOUT(NR + 4, 1) = "Keynote Speech"
arrOUT(NR + 5, 1) = "Term"
arrOUT(NR + 6, 1) = "Keyword"
arrOUT(NR, 2) = arrDATA(r, 1)
arrOUT(NR + 1, 2) = arrDATA(r, 2)
arrOUT(NR + 2, 2) = arrDATA(r, 3)
arrOUT(NR + 3, 2) = arrDATA(r, 4)
arrOUT(NR + 4, 2) = arrDATA(r, 5)
arrOUT(NR + 5, 2) = arrDATA(r, 6)
arrOUT(NR + 6, 2) = arrDATA(r, 7)
NR = NR + 8
Next r
With Sheets("Output")
.UsedRange.ClearContents
.Range("A1").Resize(UBound(arrOUT, 1), 2).Value = arrOUT
.Columns.AutoFit
.Activate
End With
End Sub
Bookmarks