Copy and Paste Values Error

[NorthbyNorthwest]

Hi, everyone. I have a sub routine that loops through about a dozen worksheets, copies a specific range from one sheet and pastes the values only to another sheet. The sub was working fine initially and is now gagging on one line of code. I don't know why. The error happens on the pastespecial paste values line of code. It reads: Addme.PasteSpecial xlPasteValues

Can you someone tell me why this is happening and how it can be rewritten?

Sub CombineMonths()
Dim ws As Worksheet
Dim Addme As Range
Dim Copyto As Range
Dim rng As Range
Dim Area As Range
Dim CombineSort As Worksheet
'Stop screen flicker
Application.ScreenUpdating = False
'Find the next row to add the data to
Set Addme = Sheet23.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
'Clear all the values
Sheet23.Unprotect
Sheet23.Range("B7:CJ3007").ClearContents
'Loop through worksheets
For Each ws In Worksheets
    'This is the range we will be copying
    Set Copyto = ws.Range("A7:CI106")
    'Use the code name in case sheet name changes
        Select Case ws.CodeName
            'Exclude these sheets by code name
            'On Error Resume Next
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", _
            "Sheet23", "Sheet24", "Sheet25", "Sheet26", "Sheet27", "Sheet28", "Sheet29", "Sheet30", "Sheet31", "Sheet32", _
            "Sheet33", "Sheet34", "Sheet35", "Sheet36", "Sheet37", "Sheet38"
            'Add the rest
            Case Else
            'Check if ws protected, if it is protected unprotect
                If SheetProtected(ws) Then
                    'If protected
                    ws.Unprotect
                    Else
                    'If not protected
                End If
        'Sort the value in case a row is deleted
        ws.Range("B7:CJ3007").Sort Key1:=ws.Range("B7"), Order1:=xlAscending, Header:=xlGuess
        'Copy the range
        Copyto.Copy
        Sheet23.Unprotect
        Addme.PasteSpecial xlPasteValues
    End Select
    'Reset the next row
    Set Addme = Sheet23.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Next ws
'Sort the combined sheet
Set CombineSort = Sheet23
CombineSort.Range("cRegion").Sort Key1:=CombineSort.Range("B7"), Order1:=xlAscending, Header:=xlGuess
'Address any misaligned data or extra spaces after transfer to combined sheet
Sheet23.Activate
Range("B7:CJ3007").Select
'Weed out any formulas from selection
  If Selection.Cells.Count = 1 Then
    Set rng = Selection
  Else
    Set rng = Selection.SpecialCells(xlCellTypeConstants)
  End If
'Trim and Clean cell values
  For Each Area In rng.Areas
    Area.Value = Evaluate("IF(ROW(" & Area.Address & "),CLEAN(TRIM(" & Area.Address & ")))")
  Next Area
  Range("A1").Select
  ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub