Error message when copying and renaming a worksheet

bdt

Board Regular
Joined
Oct 3, 2024
Messages
53
Office Version
  1. 2019
Platform
  1. Windows
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
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Which line of code is raising the error? I don't see any code that merges cells.

I have no idea what you are working on, but generally the the number of merged cells should kept to a maximum of 0.
 
Upvote 0
I appreciate your reply. I have a spreadsheet which helps plan and assign hours to certain tasks for a given week. The layout has to be arranged so it appears user friendly to all users. Unfortunately there was no way to avoid the number of merged cells.
Sadly the error does not appear to be shown in the code.
The numerous cells are merged on the worksheet "OVERTIME" not by using code
 
Upvote 0
Sorry, I misunderstood. So you get a 400 error, but you do not get a dialog box giving the option to go into Debug mode? Those are tough to trace without having the file to work with. I can't reproduce it by running this code because I don't have your data or layout. But one of the reasons to avoid merged cells is that some VBA doesn't work with merged cells the way you might think. Setting DisplayAlerts to False will not suppress VBA errors. You could try inserting
VBA Code:
On Error Resume Next
to ignore the error, but do this at your peril because you don't known what downstream problems would be created if this error is ignored. You could be jumping from the fat into the fire.

BTW I recommend wrapping your code in
[CODE]
Code tags
[/CODE]

to preserve the code formatting and make it more readable.
 
Upvote 0
advice appreciated, will have a look in the morning. Thanks
 
Upvote 0
BTW I recommend wrapping your code in
[CODE]
Code tags
[/CODE]
Hi Jeff, actually they would be better as vba code tags (as you used in your post)
[CODE=vba]
vba code goes here
[/CODE]

@bdt
The issue of using code tags when posting vba code in the forum has been raised with you recently. Since people here are taking the time to try to help you, it would be appreciated if you could take the time to investigate this to help them help you. ;)
 
Upvote 0
they would be better as vba code tags (as you used in your post)
Yes, of course, thanks. I did that out of my head. When I put my own code, I click the VBA button instead of typing the tags and I forgot about that.
 
Upvote 0
Again appreciate the feed back. Being relatively new to the forum and VBA I'm still learning. For my reference and making life easier for you guys, how would you format the below code making easier to read. I still can't get XL2BB to work.

Sub Button3_Click()
'copy overtime sunday
Dim shtSrc As Worksheet
Dim sht As Worksheet
Dim WKend As Date
Dim writerow As Long
Dim arr As Variant

For Each sht In ActiveWorkbook.Worksheets
If InStr(1, sht.Name, "W.E.**.**.**", vbTextCompare) > 0 Then Set shtSrc = sht
Next sht

With shtSrc
WKend = .Range("M2").Value2
arr = .Range("AI21:AI32").Value
End With

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

End Sub

Many thanks
 
Upvote 0
.. making life easier for you guys,
Regarding making life easier for your helpers, please refer to previous comments in post #4, post #6, the linked thread in post #6 and my recent Direct Message to you.
 
Upvote 0
For my reference and making life easier for you guys, how would you format the below code making easier to read.

1728819766542.png
 
Upvote 0

Forum statistics

Threads
1,224,812
Messages
6,181,105
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top