Run a Macro Every 7 Rows

I'm pretty new to Macros. I work for a school and we are exporting grades from one system to another. The data is exported in rows that have the students' name, ID #, course, course ID, and grades for Quarter 1, Quarter 2, Exam 1, Semester 1, Quarter 3, Quarter 4, Semester 2 in Columns. The new system requires a row entry for each grade. So I made a macro that cut and paste each grade column into separate rows and then copied the students' name, ID #, course, and course ID to those rows.

Example:

Student Name 012112 Algebra I 0123 90 80 70 80 90 90 85 88

I first used a macro to separate each entry by 7 rows. Then ran my relative Macro to get this result

Student Name 012112 Algebra I 0123 90
Student Name 012112 Algebra I 0123 80
Student Name 012112 Algebra I 0123 70
Student Name 012112 Algebra I 0123 80
Student Name 012112 Algebra I 0123 90
Student Name 012112 Algebra I 0123 90
Student Name 012112 Algebra I 0123 85
Student Name 012112 Algebra I 0123 88

The problem is that I'm unsure of how to make this Macro loop every 7 rows and save myself from getting Carpel Tunnel Syndrome.

Here is my Macro for converting the rows into columns:

Sub Grades2Rows2()
'
' Grades2Rows2 Macro
'
' Keyboard Shortcut: Option+Cmd+l
'
    ActiveCell.Range("A1:G1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:F1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:E1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:D1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:C1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:B1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-7, -4).Range("A1:D1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1:D7").Select
    ActiveSheet.Paste
End Sub

Any help would be greatly appreciated. Thanks.

Hi
Add this code to the beginning of your macro:

With originsheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For count = 1 to lastrow step 6

Put this code at the end of your macro:

Next count

Hope this helps.
Good luck.
Tony

I'm getting a "Runtime error '424': Object Required" prompt when I try to run it. Am I missing something? Thanks again.

Sub Grades2Rows3()
'
' Grades2Rows3 Macro
'
' Keyboard Shortcut: Option+Cmd+k
'
With originsheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For Count = 1 To lastrow Step 6

    ActiveCell.Range("A1:G1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:F1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:E1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:D1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:C1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1:B1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-7, -4).Range("A1:D1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1:D7").Select
    ActiveSheet.Paste
    Next Count
End Sub

Hi
Sorry before With originsheet put "Dim originsheet as Worksheet"
Tony

Hi
Are you able to post a sample of the before and after event so I can see exactly what is going on?
Tony

Hi
Looking at the sample you provided you do not need a macro to transpose rows to columns, if I understand your need correctly. Have a look at sheet 2 on the attached sample and let me know if this is what you are after.
If this is not what you are after please provide a before and after view of what you need and I will see what we can do for you.
Tony

Hello,

Attached is the desired result. The new system's import template requires each grade have its own row. I've attached the desired result on sheet 2 of the attachment below. Thank you so much for your continued help.

Hi
Can you put column headings on both sheets so I can see how both sheets correlate to each other then I may be able to suggest something.
Thanks
Tony

Hi fperez
Try the attached. The output is in new sheet.