Text box will not copy and paste with macro

[crazycatlady]

I am writing a macro that copy and pastes the information from sheet 1 to sheet 2 of the same workbook. I can get it all to work except for the text box, which has enough text that it overflows from one cell to another when copy and pasted. The text box was put in using insert-text box. When the macro runs it stops when it should paste the text box info and displays, RunTime error 1004 the item with the specified name wasn't found.

Here's the code

Sub TransferSheet1ToSheet2()
'
' TransferSheet1ToSheet2 Macro
'

'
Range("B6:B9").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveCell.Offset(0, 4).Range("A1").Select
Sheets("Sheet1").Select
ActiveCell.Offset(4, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet1").Select
ActiveCell.Offset(6, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet1").Select
ActiveCell.Offset(1, 0).Range("A1:A3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.ScrollColumn = 2
ActiveCell.Offset(0, 3).Range("A1").Select
Sheets("Sheet1").Select
ActiveSheet.Shapes.Range(Array("TextBox2")).Select
Application.CutCopyMode = False
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet1").Select
ActiveCell.Offset(2, 12).Range("A1").Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("E4:K4").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.Offset(0, 7).Range("A1").Select
Sheets("Sheet1").Select
Range("N6:N18").Select
Range("N18").Activate
Selection.ClearContents
ActiveSheet.Shapes.Range(Array("TextBox2")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
Range("B16:B19").Select
Range("B19").Activate
Selection.ClearContents
Range("B7:B10").Select
Range("B10").Activate
Selection.ClearContents
Range("B6").Select
Selection.ClearContents
End Sub

I highlighted the error in blue. Any help is appreciated but pretend like you're talking to a grandma who taught herself Excel out of a book.