Copy Range From One Sheet Paste Part of Range In Same Sheet Based On Cell Value On Another Sheet

Question 1

Another approach, this one much more flexible and easier to update:

Sub CondCopy()

    Dim ws0 As Worksheet, ws1 As Worksheet
    Dim str0 As String, str1 As String, str2 As String
    Dim strCond As String, ArrLoc As Long
    Dim strCopy As String, strPaste As String, strNum As String

    With ThisWorkbook
        Set ws0 = .Sheets("Sheet1")
        Set ws1 = .Sheets("Sheet2")
    End With

    str0 = ";One;Two;Three;Four;Five;Six;Seven;Eight;Nine;Ten;Eleven"
    str1 = ";Eleven;Ten;Nine;Eight;Seven;Six;Five;Four;Three;Two;One"
    str2 = "BUD;F01;F02;F03;F04;F05;F06;F07;F08;F09;F10;F11"
    strCond = ws0.Range("D6").Value

    ArrLoc = Application.Match(strCond, Split(str2, ";"), 0) - 1
    strNum = Split(str0, ";")(ArrLoc) & Split(str1, ";")(ArrLoc)

    strCopy = "CopyFormulasFT" & strNum
    strPaste = "PasteFormulasFT" & strNum

    With ws1
        .Range(strCopy).Copy
        .Range(strPaste).PasteSpecial xlPasteValues, SkipBlanks:=True
    End With

End Sub

In the case that you need to add more named ranges following your pattern, just editing str0, str1, and str2 is enough.

Let us know if this helps.

Question 2

Using string manipulation and a loop you could greatly reduce the size of that code:

dim arrStrings(1 to 11) as string
arrStrings(1) = "OneEleven"
arrStrings(2) = "TwoTen"
arrStrings(2) = "ThreeNine"
...
arrStrings(11) = "NineThree"

 dim  i as integer
    for i = 1 to 11
        If ws0.Range("D6") = "F"+ strings.trim(str(i)) Then
             ws1.Range("CopyFormulasFT" + arrStrings(i)).Select
             Selection.Copy
             ws1.Range("PasteFormulasFT" + arrStrigns(i)).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
             SkipBlanks:=True, Transpose:=False
        end if
    next i

if the actual code is something like this

"oneone", "onetwo", "onethree", ..., "oneeleven", "twoone", "twotwo", "twothree", ... "twoeleven" ...

(11x11 strings) you could use a double loop over this array:

dim arrStrings(1 to 11) as string
arrStrings(1) = "One"
arrStrings(2) = "Two"
arrStrings(2) = "Three"
...
arrStrings(11) = "Nine"

and you can create the string like this Str = "CopyFormulasFT"+ arrstrings(i) + arrstrings(j)

Question 3

is there a way to make my code more optimized and have less named ranges in my workbook?

depends on how your data organized. But now, you can slightly simplify your code:

Sub Test()
    Dim destRng As String
    Dim sorceRng As String

    Select Case ws0.Range("D6")
        Case "BUD"
            sorceRng = "CopyFormulasFT": destRng = "PasteFormulasFT"
        Case "F01"
            sorceRng = "CopyFormulasFTOneEleven": destRng = "PasteFormulasFTOneEleven"
        Case "F02"
            sorceRng = "CopyFormulasFTTwoTen": destRng = "PasteFormulasFTTwoTen"
        Case "F03"
            sorceRng = "CopyFormulasFTThreeNine": destRng = "PasteFormulasFTThreeNine"
        Case "F04"
            sorceRng = "CopyFormulasFTFourEight": destRng = "PasteFormulasFTFourEight"
        Case "F05"
            sorceRng = "CopyFormulasFTFiveSeven": destRng = "PasteFormulasFTFiveSeven"
        Case "F06"
            sorceRng = "CopyFormulasFTSixSix": destRng = "PasteFormulasFTSixSix"
        Case "F07"
            sorceRng = "CopyFormulasFTSevenFive": destRng = "PasteFormulasFTSevenFive"
        Case "F08"
            sorceRng = "CopyFormulasFTEightFour": destRng = "PasteFormulasFTEightFour"
        Case "F09"
            sorceRng = "CopyFormulasFTNineThree": destRng = "PasteFormulasFTNineThree"
        Case "F10"
            sorceRng = "CopyFormulasFTTenTwo": destRng = "PasteFormulasFTTenTwo"
        Case "F11"
            sorceRng = "CopyFormulasFTElevenOne": destRng = "PasteFormulasFTElevenOne"
        Case Else
            Exit Sub
    End Select

    ws1.Range(sorceRng).Copy
    ws1.Range(destRng).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True

End Sub