VBA Excel Code Running Much slower in 2010 than 2007 - vba

Question

I have some code that runs fine in Excel 2007 but when used in Excel 2010 takes about ten times longer to run and causes the whole taskbar/other programs to be unresponsive.
I don't believe hardware is the problem because the computer running Excel 2007 is a Pentium 4 with 2 gigs of ram, while the computer running 2010 is an i7 with 8 gigs of ram.
Here is the code itself:
Sub Macro6()
With Application
.ScreenUpdating = False 'Prevent screen flickering
.Calculation = xlCalculationManual 'Preventing calculation
.DisplayAlerts = False 'Turn OFF alerts
.EnableEvents = False 'Prevent All Events
End With
Dim i As Integer
Dim j As Integer
Dim Anc As String
Dim MSA As String
j = 1
Do
i = 0
MSA = ActiveCell
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(0, -2).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 2).Select
Sheets("wip").Select
Do
i = i + 1
ActiveCell.Offset(0, 1).Select
Anc = ActiveCell.Offset(-j, 0)
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(0, -1) = Anc
ActiveCell.Offset(0, -2) = MSA
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Sheets("wip").Select
Loop Until IsEmpty(ActiveCell.Offset(0, 1))
j = j + 1
ActiveCell.Offset(1, -i).Select
Loop Until IsEmpty(ActiveCell)
'Speeding Up VBA Code
With Application
.ScreenUpdating = True 'Prevent screen flickering
.Calculation = xlAutomatic 'Preventing calculation
.DisplayAlerts = True 'Turn OFF alerts
.EnableEvents = True 'Prevent All Events
End With
End Sub
The code does what I want it to, but I am concerned as to why in 2010 there is such a difference in running time?

Answer 1

Is this what you are trying to do?
Option Explicit
Sub Sample()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, j As Long, k As Long, lRow As Long, lCol As Long
On Error GoTo Whoa
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'~~> Setting the worksheets to work with
Set ws1 = Sheets("wip"): Set ws2 = Sheets("Sheet1")
'~~> Setting the start cell in "Sheet1"
k = 3
With ws1
'~~> Get the last row in Col A of "wip"
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Get the last column in row 3 of "wip"
lCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
'~~> Looping through rows in Col A in "wip"
For i = 3 To lRow
'~~> Looping through columns in the relevant row in "wip"
For j = 3 To lCol + 1
'~~> Writing output directly in "Sheet1"
ws2.Cells(k, 1).Value = ws1.Cells(i, 1).Value
ws2.Cells(k, 3).Value = ws1.Cells(i, 1).Offset(, j - 2).Value
k = k + 1
Next j
Next i
End With
LetsContinue:
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub