Are watermarks considered a merged cell?

[philwojo]

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:

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 Sub

Thanks for any help.
Phil

 

[philwojo]

It appears this has fixed the issue, thanks again for all the help.

Phil