duplicating spreadsheet without losing formulas in cells

[Ian1976]

Hi I'm using this to create/duplicate a new worksheet, is there a way I can protect the formulas which get deleted currently?
There are formulas in F4, J4, N4, R4, V4, Z4, AD4

Thanks

Sub Button1_Click()
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = GetName

Range("D4:AE29").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D4:E4").Select

End Sub

 

[6StringJazzer]

You are explicitly deleting them in your code. Expand this range reference to exclude the cells you want to keep.

Range("$D$5:$AE$29,$AE$4,$AA$4:$AC$4,$W$4:$Y$4,$O$4:$U$4,$K$4:$M$4,$G$4:$I$4,$D$4:$E$4").Select

 

[Ian1976]

So that line selects the whole area then for each selection after it "deselects" that cell?

 

[MARK858]

Slight adjustment to Jeff's code line as it was missing R4

Range("$D$5:$AE$29,$AE$4,$AA$4:$AC$4,$W$4:$Y$4,$O$4:$Q$4,$S$4:$U$4,$K$4:$M$4,$G$4:$I$4,$D$4:$E$4").Select

 

[Skyybot]

Try this:

Sub Button1_Click()
Dim cell As Range
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = GetName

Range("D4:AE29").Select
For Each cell In Selection
    If cell.HasFormula = False Then
        cell.ClearContents
        With cell.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    End If
Next cell
Range("D4:E4").Select

End Sub

 

[MARK858]

@Skyybot I would turn screenupdating off if you are going to clear the contents of the cells and format them individually

 

[MARK858]

Although I am unsure by post 1 which cells are needed to be formatted another possible option (please note that we will have to add error handling if there is ever a chance that there are no constants within the range)

Sub Button1_Click()
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = GetName

    With Range("D4:AE29")
        .SpecialCells(xlCellTypeConstants, 23).ClearContents
       
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
       
    End With
    Range("D4:E4").Select
 
End Sub

 

[Ian1976]

Thanks all, the protected cells were on every other row- F4, F6, F8 through to F28, and the same for columns J & N .......

Can I add any kind of protection to stop users from deleting the formulas manually, taking into consideration that I presume the cells need to be unprotected when the macro makes an new sheet?

Thanks for your help!

 

[MARK858]

Protect the source sheet as normal, then turn off the protection near the start of the code and back on again at the end

Sub Button1_Click()
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "New Sheet"

    With Range("D4:AE29")
        ActiveSheet.Unprotect "Your Password"
    
        On Error Resume Next
        .SpecialCells(xlCellTypeConstants, 23).ClearContents
        On Error GoTo 0
        
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
    End With
    
    Range("D4:E4").Select
  
    ActiveSheet.Protect "Your password"
  
End Sub