Help regarding copying data to excel

Dear All,
I have the below macro to move the data to excel and it working so good on 2007 and once I moved to 2013 it can't work and stop on the line below
rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row
could you please help me to solve

Moderator's note: Please take the time to review our rules. There aren't many, and they are all important. Rule #3 requires code tags. I have added them for you this time because you are a new member. --6StringJazzer

Option Explicit
Sub Semsem()
On Error GoTo clearerror
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim olItem As Outlook.MailItem
Dim vText As Variant
Dim vPara As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
    Const strPath As String = "C:\eReports\ePurchasing\New Orders.xlsx"
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No Items selected!", vbCritical, "ePurchasing"
        Exit Sub
    End If
On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
On Error GoTo 0
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Orders Data")
    For Each olItem In Application.ActiveExplorer.Selection
        sText = olItem.Body
        vText = Split(sText, Chr(13))
        rCount = xlSheet.UsedRange.Rows.Count
        rCount = rCount + 1
        rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row
        rCount = rCount + 1
        vItem = Split(vText(2) & vText(3), ChrW(1))
On Error Resume Next
        xlSheet.Range("A" & rCount) = Trim(vText(4))
        xlSheet.Range("B" & rCount) = Trim(vText(6))
        xlSheet.Range("C" & rCount) = Trim(vText(8))
        xlSheet.Range("D" & rCount) = Trim(vText(10))
        xlSheet.Range("E" & rCount) = Trim(vText(12))
        xlSheet.Range("F" & rCount) = Trim(vText(14))
        xlSheet.Range("G" & rCount) = Trim(vText(16))
        xlSheet.Range("H" & rCount) = Trim(vText(18))
        xlSheet.Range("I" & rCount) = Trim(vText(20))
        xlSheet.Range("J" & rCount) = Trim(vText(22))
        xlSheet.Range("K" & rCount) = Trim(vText(24))
        xlSheet.Range("L" & rCount) = Trim(vText(26))
        xlSheet.Range("M" & rCount) = Trim(vText(28))
        xlSheet.Range("N" & rCount) = Trim(vText(30))
        xlSheet.Range("O" & rCount) = Trim(vText(32))
        xlSheet.Range("P" & rCount) = Trim(vText(34))
        xlSheet.Range("Q" & rCount) = Trim(vText(36))
        xlSheet.Range("R" & rCount) = Trim(vText(38))
        xlSheet.Range("S" & rCount) = Trim(vText(40))
    xlWB.Save
    Next olItem
    xlWB.Close SaveChanges:=True
    If bXStarted Then
        xlApp.Quit
    End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
MsgBox "We finshed transfering items to Store" & vbNewLine & "Please run importing from ePurchasing in order to record them", vbInformation, "ePurchasing"
clearerror:
Exit Sub
End Sub