Hi, I am trying to run a macro in excel 2013 but it is very slow. It runs way faster (30 secs) on my PC with Excel 2007 but takes around 10 mins to run on my dell latitude i5 8GB ram laptop. Everything works fine except a code which is adding sheets. Excel 2013 hangs while adding sheets in a loop (For lp = 1 To r2 Step 1
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Worksheets("Opportunity Owners").Cells(lp, 1).Text

Application.Wait (Now + TimeValue("0:00:05"))

Next lp). Please let me what are the possible solutions. Thanks in advance!

Sub Sep_sheets()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim r As Integer, x As String, r2 As Integer, lp As Integer, lp2 As Integer, lp3 As Integer

    Range("A1").Select
    Selection.EntireColumn.Insert
    Columns("W:W").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Cut
    Range("A1").Select
    ActiveSheet.Paste
    Columns("O:U").Select
    Selection.EntireColumn.Hidden = True
    Range("V1").Select
    Selection.End(xlToLeft).Select


'Application.Calculation = xlCalculationManual


Range("A1").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
   r = ActiveCell.Row

x = ActiveSheet.Name

Rows(r + 2).Select
Selection.Delete Shift:=xlUp
Rows(r + 2).Select
Selection.Delete Shift:=xlUp
Rows(r + 2).Select
Selection.Delete Shift:=xlUp
Rows(r + 2).Select
Selection.Delete Shift:=xlUp
Rows(r + 2).Select
Selection.Delete Shift:=xlUp

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Opportunity Owners"

Sheets(x).Activate
Range(Cells(2, 1), Cells(r, 1)).Select
Selection.Copy
Sheets("Opportunity Owners").Activate
 Range("A1").Select
    ActiveSheet.Paste

    Dim data As Variant, temp As Variant
    Dim obj As Object
    Dim i As Long
    Set obj = CreateObject("scripting.dictionary")
    data = Selection
    For i = 1 To UBound(data)
        obj(data(i, 1) & "") = ""
    Next
    temp = obj.keys
    Selection.ClearContents
    Selection(1, 1).Resize(obj.Count, 1) = Application.Transpose(temp)


Range("A1").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
   r2 = ActiveCell.Row

For lp = 1 To r2 Step 1
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Worksheets("Opportunity Owners").Cells(lp, 1).Text

Application.Wait (Now + TimeValue("0:00:05"))

Next lp

For lp2 = 3 To r2 + 2
Sheets(x).Activate
 'Sheets("DBD --Rachel Ribbeck").Activate
  Cells.Select
    Selection.Copy
    Sheets(lp2).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
Next lp2


For lp2 = 3 To r2 + 2
Sheets(lp2).Activate

For lp3 = 2 To r
If Cells(lp3, 1) <> ActiveSheet.Name And Cells(lp3, 1) <> "" Then
'Range(Cells(lp3, 1), Cells(lp3, 1)).Activate
 Rows(lp3).Select
    Selection.Delete Shift:=xlUp
lp3 = lp3 - 1
End If
Next lp3
Range("a1").Select
Next lp2
'Application.Calculation = xlCalculationAutomatic

End Sub