Error message when copying and renaming a worksheet

[bdt]

Back again!
I have a worksheet which is copied to a new worksheet and then renamed. All worked fine until I wanted to merge cells on the original worksheet "OVERTIME" then it shows a 400 error message box when running the code. I feel its limiting the number of merged cells in"OVERTIME". Is this correct? I've tried to reduce the number of merged cells to an absolute minimum.
When I run the code it completes everything I desire then the error message appears.
Can I stop the message box by adding Application.DisplayAlerts = False and then Application.DisplayAlerts = True somewhere in my code or is it more complex.
I'm probably not supposed to add all the code as its quite long, but can't get Xl2BB to work. My code is;

Public Sub CopySheetAndRenamePredefined()



Application.ScreenUpdating = False
Dim ws As Worksheet
Dim response As String
For Each ws In Sheets
If ws.Range("B2") <> "" And ws.Range("C2") = "" Then
Do
response = InputBox("Input date in format **/**/**")
If response <> "" Then
ws.Range("C2") = response
Exit Do
ElseIf response = "" Then
MsgBox ("You must enter date in format **/**/**")

Else: Exit Do
End If
Loop

End If
Next ws
Application.ScreenUpdating = True

Dim WKend
Dim arr As Variant
Dim writerow As Long


'copy overtime sunday
With Sheets("ABACUS")
WKend = .Range("M2").Value2
arr = .Range("AI21:AI33").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1

writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A2") = Format(Date, "dd/mm/yy")
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime monday
With Sheets("ABACUS")
WKend = .Range("AC2").Value2
arr = .Range("AK21:AK32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime tuesday
With Sheets("ABACUS")
WKend = .Range("AS2").Value2
arr = .Range("AM21:AM32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime wednesday
With Sheets("ABACUS")
WKend = .Range("BI2").Value2
arr = .Range("AO21:AO32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime thursday
With Sheets("ABACUS")
WKend = .Range("BY2").Value2
arr = .Range("AQ21:AQ32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime friday
With Sheets("ABACUS")
WKend = .Range("CO2").Value2
arr = .Range("AS21:AS32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
End With

'copy overtime saturday
With Sheets("ABACUS")
WKend = .Range("DE2").Value2
arr = .Range("AU21:AU32").Value
End With

With Sheets("OVERTIME")
' last used row in column B plus 1
writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & writerow) = WKend
.Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
.Range("A" & writerow & ":X" & writerow).Borders(xlEdgeBottom).LineStyle = xlContinuous
End With



ActiveSheet.Copy After:=Worksheets("OVERTIME")
ActiveSheet.Name = "W.E." & Format(Range("C2").Value, "dd.mm.yy")
ActiveSheet.Shapes("Button 1").Delete



ActiveSheet.Buttons.add(75, 150, 150, 100).Select
With Selection
.Name = "New Button"
.OnAction = "Button3_Click"
.Text = "SAVE CHANGES"
.Font.Size = 24
.Font.Bold = True
End With


Worksheets("ABACUS").Activate
Range("D5:DK17").ClearContents
Range("C2").ClearContents
Range("BP22:CE33").ClearContents
Range("E3,G3,I3,K3,M3,O3,Q3,S3,U3,W3,Y3,AA3,AC3,AE3,AG3,AI3,AK3,AM3,AO3,AQ3,AS3,AU3,AW3,AY3,BA3,BC3,BE3,BG3,BI3,BK3,BM3,BO3").ClearContents
Range("BQ3,BS3,BU3,BW3,BY3,CA3,CC3,CE3,CG3,CI3,CK3,CM3,CO3,CQ3,CS3,CU3,CW3,CY3,DA3,DC3,DE3,DG3,DI3,DK3").ClearContents
[B25] = Range("DM2").Value
[B26] = Range("DM2").Value
[B27] = Range("DM2").Value
[B28] = Range("DM2").Value
[B29] = Range("DM2").Value
[B30] = Range("DM2").Value
[B31] = Range("DM2").Value
[B32] = Range("DM2").Value



End Sub


Many thanks

 

[bdt]

Thanks for your input

 

[bdt]

Not sure how, but this issue is now resolved.
Thanks for your comments / suggestions

 

[jolivanes]

From the "Worksheets("ABACUS").Activate" line at the end, I would change that line and the next 13 lines to:

With Worksheets("ABACUS")
    .Range("C2, D5:DK17, BP22:CE33").ClearContents
        For i = 5 To 115 Step 2
            .Cells(3, i).ClearContents
        Next i
    .Range("B25:B32").Value = .Range("DM2").Value
End With

Looks like there is a lot more that can be streamlined but that needs an explanation of what you want to do.

 

[smozgur]

Not sure how, but this issue is now resolved.
Thanks for your comments / suggestions

Good to hear you got the solution.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Or, you can mark another answer as the solution that you think helped to solve the problem. Otherwise, please do not mark a post that doesn't contain a solution.