Hello, I am helping my wife with a spreadsheet she is using for work and it was up and working fine, thanks to help I had received previously. But now she and one of her coworkers were asked to add a watermark to the sheet on each tab. Now when the script is called it stops and give the following errors:
Run-time error '1004':
cannot change part of a merged cell.
I searched for merged cells in the document and as far as the script is concerned there are none, other than maybe this new watermark.
So, does VBA or scripting think that a watermark is a merged cell?
Is there any kind of a workaround if it does think of it as being merged?
Here is the current script we are using:
Thanks for any help.
Phil
Run-time error '1004':
cannot change part of a merged cell.
I searched for merged cells in the document and as far as the script is concerned there are none, other than maybe this new watermark.
So, does VBA or scripting think that a watermark is a merged cell?
Is there any kind of a workaround if it does think of it as being merged?
Here is the current script we are using:
Code:
Sub CopyFmMaster()
'Developed by ASidman 1/27/2014
Set Rng = ActiveCell
Application.ScreenUpdating = False
Application.Run ("Unprotect_all_sheets")
'Delete all information in Range B3:K-last row
Dim w As Worksheet
For Each w In Worksheets
Dim lrx As Long
lrx = w.Range("B" & Rows.Count).End(xlUp).Row
If w.Name <> "Master - INPUT ONLY" And w.Name <> "Sheet3" Then
w.Range("B3:K" & lrx).Clear
End If
Next w
'Copy data from Input Sheet to detailed sheets
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim w3 As Worksheet
Dim w4 As Worksheet
Dim w5 As Worksheet
Dim w6 As Worksheet
Set w1 = Sheets("Master - INPUT ONLY")
Set w2 = Sheets("Closed to New Investors")
Set w3 = Sheets("Liquidation")
Set w4 = Sheets("Merger")
Set w5 = Sheets("Name Change")
Set w6 = Sheets("New Product Launch")
Dim i As Long
Dim lr1 As Long
lr1 = w1.Range("A" & Rows.Count).End(xlUp).Row
Dim lr2 As Long
Dim lr3 As Long
Dim lr4 As Long
Dim lr5 As Long
Dim lr6 As Long
For i = 3 To lr1
lr2 = w2.Range("B" & Rows.Count).End(xlUp).Row
lr3 = w3.Range("B" & Rows.Count).End(xlUp).Row
lr4 = w4.Range("B" & Rows.Count).End(xlUp).Row
lr5 = w5.Range("B" & Rows.Count).End(xlUp).Row
lr6 = w6.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If w1.Range("D" & i) = "Closed to New Investors" Then
w1.Range("B" & i & ":K" & i).Copy w2.Range("B" & lr2 + 1)
ElseIf w1.Range("D" & i) = "Liquidation" Then
w1.Range("B" & i & ":K" & i).Copy w3.Range("B" & lr3 + 1)
ElseIf w1.Range("D" & i) = "Merger" Then
w1.Range("B" & i & ":K" & i).Copy w4.Range("B" & lr4 + 1)
ElseIf w1.Range("D" & i) = "Name Change" Then
w1.Range("B" & i & ":K" & i).Copy w5.Range("B" & lr5 + 1)
ElseIf w1.Range("D" & i) = "New Product Launch" Then
w1.Range("B" & i & ":K" & i).Copy w6.Range("B" & lr6 + 1)
End If
Next i
Application.CutCopyMode = False
'Sort Data in each sheet by the data in Ascending order.
For Each w In Worksheets
If w.Name <> "Master - INPUT ONLY" And w.Name <> "Sheet3" Then
lrx = w.Range("B" & Rows.Count).End(xlUp).Row
Range("B2:K" & lrx).Sort Key1:=Columns("E"), Order1:=xlDescending, Header:=xlYes, DataOption1:=x1SortNormal
End If
Next w
Application.Run ("Sort_Newest_to_Oldest")
Application.Run ("Protect_all_sheets")
Application.ScreenUpdating = True
Application.Goto Rng
MsgBox ("Update Completed")
End SubThanks for any help.
Phil
