Run-time error '1004': We Can't do that to a merged cell

[Sarche]

I wrote a VBA code that was working until a few days ago now I am getting an error message that is can't do that to a merged cell when trying to copy and paste. However, there are no merged cells in the section that is being copied and pasted. Below is the code that keeps throwing the error message. I cannot figure out why I keep getting this message. Here is a link to a sample worksheet for the entire code.

20-8010 - FAIRMOUNT CHATTSWORTH STATION - Sample.xlsm

Select Case Sheets("Job2Date").Range("A1") = ""
Case True
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("A7")
Case False
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("XFD7").End(xlToLeft).Offset(0, 1)
End Select

 

[Fluff]

How would the code know what the new sheet name was?

 

[Sarche]

How would the code know what the new sheet name was?

I have this code as part of the main code.

'''Adjust formulas for new sheet'''
Call Replace

That refers to this code.

Sub Replace()

    Dim Last_Col As Long
    Dim Last_Row As Long
    
    
    'Sheets("Job2Date").Range ("W12:Z701")
    'Sheets("Week (1)").Select
    'Range("A442").Select
    'Selection.Copy
    
    Last_Col = Sheets("Job2Date").Cells(8, Columns.Count).End(xlToLeft).Column 'define the last column for the new range
    Last_Row = Sheets("Job2Date").Cells(Rows.Count, Last_Col - 3).End(xlUp).Row 'define the last row for the new range based on the last column created from Last_Col
    Debug.Print ThisWorkbook.new_sht_added
    
    Sheets("Job2Date").Activate
    ThisWorkbook.Sheets("Job2Date").Range(Sheets("Job2Date").Cells(8, Last_Col - 3), Sheets("Job2Date").Cells(Last_Row, Last_Col)).Select
    
   
    ThisWorkbook.Sheets("Job2Date").Range(Cells(11, Last_Col - 3), Cells(Last_Row, Last_Col)).Replace What:="Week", Replacement:="'" + ThisWorkbook.new_sht_added + "'", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
    'Range("A6:A9").Replace What:="'" & "*" & "'", Replacement:="'" + NewSheet + "'", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Range("A3").Select
    
End Sub

 

[Sarche]

How would the code know what the new sheet name was?

All of this worked until this week. I have no idea what I have done to make it stop working. I appreciate all your help.

 

[Fluff]

Try

    With Sheets("Job2Date")
      .Range(.Cells(11, Last_Col - 4), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With

 

[Sarche]

Try

    With Sheets("Job2Date")
      .Range(.Cells(11, Last_Col - 4), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With

I got Run-time error '1004': Application-defined or object-defined error.

 

[Fluff]

Not sure why you got that, as it worked for me on your workbook. How are you running the macro?
Also noticed a slight error, it should be

    With Sheets("Job2Date")
      .Range(.Cells(11, Last_Col - 3), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With

 

[Sarche]

VBA Code:

    With Sheets("Job2Date")
      .Range(.Cells(11, Last_Col - 3), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With

Did you replace 'Call Replace' with this code? I am running it by clicking the plus sign and adding a new sheet. it gets stuck at that code and gives me the Run-time error '1004': Application-defined or object-defined error.

 

[Fluff]

I was also running it by adding a new sheet & everything worked.
Add the msgbox as shown, what does it say

Sub Replace()

    Dim Last_Col As Long
    Dim Last_Row As Long
    
    
    'Sheets("Job2Date").Range ("W12:Z701")
    'Sheets("Week (1)").Select
    'Range("A442").Select
    'Selection.Copy
    
    Last_Col = Sheets("Job2Date").Cells(8, Columns.Count).End(xlToLeft).Column 'define the last column for the new range
    Last_Row = Sheets("Job2Date").Cells(Rows.Count, Last_Col - 3).End(xlUp).Row 'define the last row for the new range based on the last column created from Last_Col
    Debug.Print ThisWorkbook.new_sht_added
    
    Sheets("Job2Date").Activate
    ThisWorkbook.Sheets("Job2Date").Range(Sheets("Job2Date").Cells(8, Last_Col - 3), Sheets("Job2Date").Cells(Last_Row, Last_Col)).Select
    
   MsgBox "Last Col " & Last_Col & vbLf & "Last row " & Last_Row & vbLf & "Sheetname " & ThisWorkbook.new_sht_added
    With Sheets("Job2Date")
      .Range(.Cells(11, Last_Col - 3), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With
    'Range("A6:A9").Replace What:="'" & "*" & "'", Replacement:="'" + NewSheet + "'", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Range("A3").Select
    
End Sub

 

[Sarche]

Dim Last_Col As Long Dim Last_Row As Long 'Sheets("Job2Date").Range ("W12:Z701") 'Sheets("Week (1)").Select 'Range("A442").Select 'Selection.Copy Last_Col = Sheets("Job2Date").Cells(8, Columns.Count).End(xlToLeft).Column 'define the last column for the new range Last_Row = Sheets("Job2Date").Cells(Rows.Count, Last_Col - 3).End(xlUp).Row 'define the last row for the new range based on the last column created from Last_Col Debug.Print ThisWorkbook.new_sht_added Sheets("Job2Date").Activate ThisWorkbook.Sheets("Job2Date").Range(Sheets("Job2Date").Cells(8, Last_Col - 3), Sheets("Job2Date").Cells(Last_Row, Last_Col)).Select MsgBox "Last Col " & Last_Col & vbLf & "Last row " & Last_Row & vbLf & "Sheetname " & ThisWorkbook.new_sht_added With Sheets("Job2Date") .Range(.Cells(11, Last_Col - 3), .Cells(Last_Row, Last_Col)).Replace What:="Week (*)", Replacement:=ThisWorkbook.new_sht_added, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End With 'Range("A6:A9").Replace What:="'" & "*" & "'", Replacement:="'" + NewSheet + "'", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Range("A3").Select

That was my mistake I was adding it in the main code not under my replace code. It worked this time. THANK YOU! Everything seems to be working now. I really appreciate you helping me.

 

[Fluff]

Glad we could help & thanks for the feedback.