The Object Invoked Has Disconnected

I have been search through a lot of forums and I cannot figure out how to correct my issue. The intent of my spreadsheet is to read the emails in a certain folder in my outlook inbox, parse those emails and display them in a different format on another sheet within excel. I have one sub pull in the emails to my "Import Sheet", and another sub that manipulates those fields and places the data into another sheet ("TMS_Log") in my desired format.
Within the import sheet cell 'A1' represents the first email body, cell 'A2' represents the second email body and so on. I have no issues with my sub that brings in the email contents, my issue resides only with my sub that manipulates the data. To make things even more complicated my code works at home using Excel 2007, but does not work within my office computer (where I need it to work) using Excel 2003. When I step through the sub it works properly about 2-3 times and then it gets an error. Below is the error that I recieve:

System Error &H80010108(-2147417848). The object invoked has disconnected from it's clients. MFR VZB090813-003 PPSM.

Unfortunately I am not the best with VBA and a lot of my code is just a hodge podge of code that I have found on the web and threw together to test what it does. Many times when reading the explanations of what to do to fix things I get lost becuase of my lack of VBA background.

Below is the block of code that I have issues with.

Sub cellparse()

Dim Contents As String
Dim a
Dim x As Integer
Dim currentrow As Long
Dim blah As String
'Dim emailcount
Dim y
Dim blahblah As String

blah = "a"
blahblah = "b"
x = 0
sheetonerow = 2
currentrow = 1
'emailcount = Workbooks(1).Sheets(2).Column.CountA

Do
'Parse the content in column A into individual cells in column B.
'Contents = Range("A1").Value
Workbooks(1).Sheets(2).Select
Cells(currentrow, blah).Select
Contents = Workbooks(1).Sheets(2).Cells(currentrow, blah).Value
a = Split(Contents, Chr(10))
Range("B1").Resize(UBound(a) + 1) = Application.WorksheetFunction.Transpose(a)
'Change the vertical fields into horizontal fields.
Workbooks(1).Sheets(2).Select
Range("B4:B21").Select
Selection.Copy
Workbooks(1).Sheets(2).Range("C1").Select
Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
'Select values to cut from "Import Sheet"
'Sheets("Import Sheet").Select
Workbooks(1).Sheets(2).Range("C1:T1").Select
Selection.Copy
Workbooks(1).Sheets(1).Activate
Workbooks(1).Sheets(1).Cells(sheetonerow, blahblah).Select
'Workbooks(1).Sheets(1).Range("B2").Select
Workbooks(1).Sheets(1).Paste
'Switch to Sheet 2 and Clear Column B of import sheet
Workbooks(1).Sheets(2).Activate
Columns("B:T").Select
Selection.Clear
'Increment the Import Sheet column A row by 1
currentrow = currentrow + 1
'Increment the Do count by 1
x = x + 1
'Increment The TMS Log Sheet 1 row
sheetonerow = sheetonerow + 1
Loop Until x > 10
End Sub

Any help with this would be much appreciated! I attached the excel spreadsheet and changed around the content of the email to reflect only 5 generic email messages. Thanks in advance I am very green with VBA.