从一张纸复印范围根据另一张纸上的单元格值粘贴同一张纸上的部分范围
现在我已经创build了一个代码，可以将一个范围内的值复制到另一个范围内（基于另一个表单的值）。
但是因为这个值可以是十二个值中的一个，所以被复制和粘贴的范围变小。
由于我不擅长VBA，因此我在Excel中创build了数十个复制范围和几十个粘贴范围，以便通过VBA处理ElseIf语句来复制和粘贴，具体取决于单元格值在另一个表单中。
我很好奇，有没有办法让我的代码更加优化，并在我的工作簿有更less的命名范围？
任何帮助，将不胜感激，这里是我的代码下面粘贴（复制和粘贴的每个命名范围只是一个较less的列，由于什么select可以在第一张表）：
SubTest() If ws0.Range("D6") = "BUD" Then ws1.Range("CopyFormulasFT").Select Selection.Copy ws1.Range("PasteFormulasFT").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F01" Then ws1.Range("CopyFormulasFTOneEleven").Select Selection.Copy ws1.Range("PasteFormulasFTOneEleven").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F02" Then ws1.Range("CopyFormulasFTTwoTen").Select Selection.Copy ws1.Range("PasteFormulasFTTwoTen").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F03" Then ws1.Range("CopyFormulasFTThreeNine").Select Selection.Copy ws1.Range("PasteFormulasFTThreeNine").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F04" Then ws1.Range("CopyFormulasFTFourEight").Select Selection.Copy ws1.Range("PasteFormulasFTFourEight").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F05" Then ws1.Range("CopyFormulasFTFiveSeven").Select Selection.Copy ws1.Range("PasteFormulasFTFiveSeven").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F06" Then ws1.Range("CopyFormulasFTSixSix").Select Selection.Copy ws1.Range("PasteFormulasFTSixSix").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F07" Then ws1.Range("CopyFormulasFTSevenFive").Select Selection.Copy ws1.Range("PasteFormulasFTSevenFive").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F08" Then ws1.Range("CopyFormulasFTEightFour").Select Selection.Copy ws1.Range("PasteFormulasFTEightFour").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F09" Then ws1.Range("CopyFormulasFTNineThree").Select Selection.Copy ws1.Range("PasteFormulasFTNineThree").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F10" Then ws1.Range("CopyFormulasFTTenTwo").Select Selection.Copy ws1.Range("PasteFormulasFTTenTwo").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False ElseIf ws0.Range("D6") = "F11" Then ws1.Range("CopyFormulasFTElevenOne").Select Selection.Copy ws1.Range("PasteFormulasFTElevenOne").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False End If End Sub 另一种方法，这个更灵活，更容易更新：
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
在你需要添加更多命名范围的情况下，只需编辑str0 ， str1和str2就足够了。
让我们知道这是否有帮助。
使用string操作和循环可以大大减less代码的大小：
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
如果实际的代码是这样的
“oneone”，“onetwo”，“onethree”，…，“oneeleven”，“twoone”，“twotwo”，“twothree”，…“twoeleven”…
（11x11string），你可以在这个数组上使用双循环：
dim arrStrings(1 to 11) as string arrStrings(1) = "One" arrStrings(2) = "Two" arrStrings(2) = "Three" ... arrStrings(11) = "Nine"
你可以像这样创buildstringStr =“CopyFormulasFT”+ arrstrings（i）+ arrstrings（j）
有没有办法让我的代码更加优化，并在我的工作簿有更less的命名范围？
取决于你的数据如何组织。 但现在，你可以稍微简化你的代码：
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