Can anyone clean this code?

[fidgen]

Hiya, I've made the following to jig some excel worksheets around into a format more useful for SPSS analysis, but the code (as you can see) is hardly elegant in its simplicity and so take a few seconds more than it should to execute. Can anyone suggest a cleaner way of executing the large messy middle section?

Thanks
hugh





****************************************
========================================


Sub SPSSoutput()

Dim A As Integer
Dim B As Byte, D As Byte, E As Byte


For B = 1 To 7

For A = 2 To 5000
If Sheets(1).Cells(A, 1) = "" Then
Exit For
End If

Sheets(2).Cells(A, B) = Sheets(1).Cells(A, B)
D = 8
E = 9
Sheets(2).Cells(A, D + 0) = Sheets(1).Cells(A + 0, E + 0)
Sheets(2).Cells(A, D + 1) = Sheets(1).Cells(A + 1, E + 0)
Sheets(2).Cells(A, D + 2) = Sheets(1).Cells(A + 2, E + 0)
Sheets(2).Cells(A, D + 3) = Sheets(1).Cells(A + 0, E + 1)
Sheets(2).Cells(A, D + 4) = Sheets(1).Cells(A + 1, E + 1)
Sheets(2).Cells(A, D + 5) = Sheets(1).Cells(A + 2, E + 1)
Sheets(2).Cells(A, D + 6) = Sheets(1).Cells(A + 0, E + 2)
Sheets(2).Cells(A, D + 7) = Sheets(1).Cells(A + 1, E + 2)
Sheets(2).Cells(A, D + = Sheets(1).Cells(A + 2, E + 2)
Sheets(2).Cells(A, D + 9) = Sheets(1).Cells(A + 0, E + 3)
Sheets(2).Cells(A, D + 10) = Sheets(1).Cells(A + 1, E + 3)
Sheets(2).Cells(A, D + 11) = Sheets(1).Cells(A + 2, E + 3)
Sheets(2).Cells(A, D + 12) = Sheets(1).Cells(A + 0, E + 4)
Sheets(2).Cells(A, D + 13) = Sheets(1).Cells(A + 1, E + 4)
Sheets(2).Cells(A, D + 14) = Sheets(1).Cells(A + 2, E + 4)
Sheets(2).Cells(A, D + 15) = Sheets(1).Cells(A + 0, E + 5)
Sheets(2).Cells(A, D + 16) = Sheets(1).Cells(A + 1, E + 5)
Sheets(2).Cells(A, D + 17) = Sheets(1).Cells(A + 2, E + 5)
Sheets(2).Cells(A, D + 18) = Sheets(1).Cells(A + 0, E + 6)
Sheets(2).Cells(A, D + 19) = Sheets(1).Cells(A + 1, E + 6)
Sheets(2).Cells(A, D + 20) = Sheets(1).Cells(A + 2, E + 6)
Sheets(2).Cells(A, D + 21) = Sheets(1).Cells(A + 0, E + 7)
Sheets(2).Cells(A, D + 22) = Sheets(1).Cells(A + 1, E + 7)
Sheets(2).Cells(A, D + 23) = Sheets(1).Cells(A + 2, E + 7)
Sheets(2).Cells(A, D + 24) = Sheets(1).Cells(A + 0, E +
Sheets(2).Cells(A, D + 25) = Sheets(1).Cells(A + 1, E +
Sheets(2).Cells(A, D + 26) = Sheets(1).Cells(A + 2, E +
Sheets(2).Cells(A, D + 27) = Sheets(1).Cells(A + 0, E + 9)
Sheets(2).Cells(A, D + 28) = Sheets(1).Cells(A + 1, E + 9)
Sheets(2).Cells(A, D + 29) = Sheets(1).Cells(A + 2, E + 9)
Sheets(2).Cells(A, D + 30) = Sheets(1).Cells(A + 0, E + 10)
Sheets(2).Cells(A, D + 31) = Sheets(1).Cells(A + 1, E + 10)
Sheets(2).Cells(A, D + 32) = Sheets(1).Cells(A + 2, E + 10)
Sheets(2).Cells(A, D + 33) = Sheets(1).Cells(A + 0, E + 11)
Sheets(2).Cells(A, D + 34) = Sheets(1).Cells(A + 1, E + 11)
Sheets(2).Cells(A, D + 35) = Sheets(1).Cells(A + 2, E + 11)
Sheets(2).Cells(A, D + 36) = Sheets(1).Cells(A + 0, E + 12)
Sheets(2).Cells(A, D + 37) = Sheets(1).Cells(A + 1, E + 12)
Sheets(2).Cells(A, D + 38) = Sheets(1).Cells(A + 2, E + 12)
Sheets(2).Cells(A, D + 39) = Sheets(1).Cells(A + 0, E + 13)
Sheets(2).Cells(A, D + 40) = Sheets(1).Cells(A + 1, E + 13)
Sheets(2).Cells(A, D + 41) = Sheets(1).Cells(A + 2, E + 13)
Sheets(2).Cells(A, D + 42) = Sheets(1).Cells(A + 0, E + 14)
Sheets(2).Cells(A, D + 43) = Sheets(1).Cells(A + 1, E + 14)
Sheets(2).Cells(A, D + 44) = Sheets(1).Cells(A + 2, E + 14)
Sheets(2).Cells(A, D + 45) = Sheets(1).Cells(A + 0, E + 15)
Sheets(2).Cells(A, D + 46) = Sheets(1).Cells(A + 1, E + 15)
Sheets(2).Cells(A, D + 47) = Sheets(1).Cells(A + 2, E + 15)
Sheets(2).Cells(A, D + 48) = Sheets(1).Cells(A + 0, E + 16)
Sheets(2).Cells(A, D + 49) = Sheets(1).Cells(A + 1, E + 16)
Sheets(2).Cells(A, D + 50) = Sheets(1).Cells(A + 2, E + 16)
Sheets(2).Cells(A, D + 51) = Sheets(1).Cells(A + 0, E + 17)
Sheets(2).Cells(A, D + 52) = Sheets(1).Cells(A + 1, E + 17)
Sheets(2).Cells(A, D + 53) = Sheets(1).Cells(A + 2, E + 17)
Sheets(2).Cells(A, D + 54) = Sheets(1).Cells(A + 0, E + 18)
Sheets(2).Cells(A, D + 55) = Sheets(1).Cells(A + 1, E + 18)
Sheets(2).Cells(A, D + 56) = Sheets(1).Cells(A + 2, E + 18)
Sheets(2).Cells(A, D + 57) = Sheets(1).Cells(A + 0, E + 19)
Sheets(2).Cells(A, D + 58) = Sheets(1).Cells(A + 1, E + 19)
Sheets(2).Cells(A, D + 59) = Sheets(1).Cells(A + 2, E + 19)
Sheets(2).Cells(A, D + 60) = Sheets(1).Cells(A + 0, E + 20)
Sheets(2).Cells(A, D + 61) = Sheets(1).Cells(A + 1, E + 20)
Sheets(2).Cells(A, D + 62) = Sheets(1).Cells(A + 2, E + 20)
Sheets(2).Cells(A, D + 63) = Sheets(1).Cells(A + 0, E + 21)
Sheets(2).Cells(A, D + 64) = Sheets(1).Cells(A + 1, E + 21)
Sheets(2).Cells(A, D + 65) = Sheets(1).Cells(A + 2, E + 21)
Sheets(2).Cells(A, D + 66) = Sheets(1).Cells(A + 0, E + 22)
Sheets(2).Cells(A, D + 67) = Sheets(1).Cells(A + 1, E + 22)
Sheets(2).Cells(A, D + 68) = Sheets(1).Cells(A + 2, E + 22)
Sheets(2).Cells(A, D + 69) = Sheets(1).Cells(A + 0, E + 23)
Sheets(2).Cells(A, D + 70) = Sheets(1).Cells(A + 1, E + 23)
Sheets(2).Cells(A, D + 71) = Sheets(1).Cells(A + 2, E + 23)


A = A + 2

Next 'a
Next 'b

Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom


End Sub

 

[fidgen]

I've added

Application.ScreenUpdating = False

which has shaved a second or 2 off!

 

[Richie(UK)]

Hi fidgen,

Depending on the format of your workbook, you may also like to consider adding Application.Calculation = xlCalculateManual to the beginning of your code.

(Switch back to Automatic at the end)

HTH