Macro to value Data

[howard]

I have data with Formula's in the following columns and rows



B18:M18 (Text in A18 Dept1)
B31:M31 (Text in A31 Dept2)
B45:M45 (Text in A31 Dept3)
B61:M61 (Text in A31 Dept4)

I would like to know if there is a better way to write the code, possible using range names as the rows may change from time to time so the ranges would have to be amended in the code


Your assistance in this regard is most appreciated

Sub Range_ValPRofits_BR1()
With Sheets("BR1")
.Range("B18:M18").Copy
.Range("B19").PasteSpecial Paste:=xlPasteValues
.Range("B31:M31").Copy
.Range("B32").PasteSpecial Paste:=xlPasteValues
.Range("B45:M45").Copy
.Range("B46").PasteSpecial Paste:=xlPasteValues
.Range("B61:M61").Copy
.Range("B62").PasteSpecial Paste:=xlPasteValues
   .Application.CutCopyMode = False
   End With
  
End Sub

 

[GWteB]

Are there any more future changes to be expected?

 

[howard]

There will no future changes

 

[GWteB]

Right, somehow misunderstood. Most likely this is what you're after ...

Sub Range_ValPRofits_BR1()

    Dim arr As Variant
    Dim n   As Variant
    Dim c   As Range

    arr = Array("NVNP_BR1", "UVNP_BR1", "SVCNP_BR1", "totalNP_Br1")

    Application.ScreenUpdating = False
    With Sheets("BR1")
        For Each n In arr
            For Each c In .Range(n)
                If Not InStr(1, .Cells(5, c.Column).Value, "current", vbTextCompare) > 0 Then
                    c.Copy
                    c.Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next c
        Next n
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    Range("a1").Select
End Sub

 

[howard]

Thanks very much. This is perfect

 

[GWteB]

You are welcome and thanks for letting me know.