将命名区域复制到活动工作表
我试图从Wk1工作表中复制命名的范围到工作簿中的活动工作表。
我在运行代码时不断收到错误消息。 他们要么说没有设置对象，要么variables没有被声明。
Sub ChangeNamedRangesOnNewWKsheet() Dim RangeName As Name Dim HighlightRange As Range Dim RangeName2 As String Dim NewRangeName As String Dim Ws As Worksheets Dim cs As Worksheet Set cs = Application.ActiveSheet ''''' Delete invalid named ranges For Each RangeName In ActiveWorkbook.Names If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then RangeName.Delete End If Next RangeName For Each RangeName In Ws If InStr(1, RangeName, "Wk1", 1) > 0 Then Set HighlightRange = RangeName.RefersToRange NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name") RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'") On Error Resume Next HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2) Range(RangeName2).Name = NewRangeName On Error GoTo 0 End If Next RangeName MsgBox "Done" End Sub
我改变了这个代码。 我没有得到错误消息，但代码仍然无法正常工作。 命名的范围不会从Wk1表单复制到活动表单。 唯一发生的是消息框打开
Sub ChangeNamedRangesOnNewWKsheet() Dim RangeName As Name Dim HighlightRange As Range Dim RangeName2 As String Dim NewRangeName As String Dim Cs As Worksheet Set Cs = Application.ActiveSheet ''''' Delete invalid named ranges For Each RangeName In ActiveWorkbook.Names If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then RangeName.Delete End If Next RangeName For Each RangeName In ActiveWorkbook.Names If InStr(1, RangeName, "Wk1", 1) > 0 Then Set HighlightRange = RangeName.RefersToRange NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name") RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'") On Error Resume Next HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2) Range(RangeName2).Name = NewRangeName On Error GoTo 0 End If Next RangeName MsgBox "Done" End Sub
花了我一些时间来弄清楚没有错误时什么不工作，但最后我想我设法弄清楚了这个问题。
在您的代码中replace以下行
HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
至：
HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address)
这应该给你想要的结果。
复制到目标的语法是Destination:=Worksheets("sheet_name").Range(range) 。 这里的sheet_name应该是工作表的名字。 所以，当你写作Worksheets("cs.Name")代码会查找名为cs.Name的表，它实际上不存在，因此只需使用Worksheets(cs.Name) 。 第二件事是范围（只是为了更好的解释我使用$ A $ 1：$ A $ 5作为范围）。 当你写.Range(RangeName2)代码正在寻找'cs.Name'!$A$1:$A$5 。 这又是不正确的，因为范围应该写成.Range($A$1:$A$5) 。 所以.Range(HighlightRange.Address)会给你适当的范围。
您也可以在RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'")以获取正确的地址。
希望这可以帮助。
编辑 ： __________________________________________________________________________________
我想要的例子。 从Wk1表格复制Wk1Totalhrs到Wk2-Wk7表格，Wk1Totalhrs在相应的新表格上变成Wk2Totalhrs，Wk3Totalhrs等
尝试下面的代码，以达到您在评论中提到的要求（或如上所述）。
Sub ChangeNamedRangesOnNewWKsheet() Dim RangeName As Name Dim HighlightRange As Range Dim RangeName2 As String, NewRangeName As String, SearchRange As String Dim MyWrkSht As Worksheet, cs As Worksheet Set MyWrkSht = ActiveWorkbook.Worksheets("Wk1") SearchRange = "Wk1Totalhrs" '---> enter name of the range to be copied ''''' Delete invalid named ranges For Each RangeName In MyWrkSht.Names If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then RangeName.Delete End If Next RangeName 'For Each RangeName In MyWrkSht.Names ActiveWorkbook.Names For Each RangeName In ActiveWorkbook.Names If RangeName.Name = SearchRange Then '---> search for the named range Wk1Totalhrs Set HighlightRange = RangeName.RefersToRange For Each cs In ActiveWorkbook.Sheets Debug.Print cs.Name If cs.Name <> "Wk1" Then '---> don't do anything in the sheet Wk1 NewRangeName = Replace(RangeName.Name, "Wk1", cs.Name) RangeName2 = Replace(RangeName, "='Wk1'", cs.Name) HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address) Range(RangeName2).Name = NewRangeName End If Next cs End If Next RangeName End Sub
我觉得就这么简单
Public Sub ShowNames() Dim Nm As Name Dim i As Long For Each Nm In ActiveWorkbook.Names i = i + 1 Range("A1").Offset(i, 0).Value = Nm Next Nm End Sub
我没有得到错误消息，但代码仍然无法正常工作。
命名的范围不会从Wk1表单复制到活动表单。
当命名范围以WK10或WK11开头时，以下行将返回误报
If InStr(1, RangeName, "Wk1", 1) > 0 Then
再往下看，你是在引用一个variables属性; 这使得它成为一个文字string，而不是variables属性的值。
NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")
您需要更具体的方法来识别WK1上定义的名称。 仔细查看你的问题后，我相信你可能有一个或多个由公式定义的dynamic命名范围。 这将解释你的代码应该使用更传统的ReferTo：属性的一些“不工作”的行为。
还有一个问题是，你应该重写RefersTo：现有的已定义命名范围还是添加一个新的命名范围。 一种常见的做法是简单地尝试删除命名范围un On Error Resume Next ，然后创build一个新的。 我从来不喜欢这种方法，原因很多， 一个是删除一个命名的范围将使依赖的命名范围引用#REF! 我从来没有考虑错误的简历旁边是一个“最佳做法”。
以下内容将构build包含要创build的命名范围的键和使用多个条件存在的键的字典。 我已经对传统和dynamic命名范围的组合进行了重复testing，并取得了成功。
Option Explicit Sub ChangeNamedRangesOnNewWKsheet() Dim nm As Name Dim rtr As String, nm2 As String Dim w As Long Dim k As Variant, dict As Object Set dict = CreateObject("Scripting.Dictionary") dict.comparemode = vbTextCompare With ActiveWorkbook 'Delete invalid named ranges and build dictionary of valid ones from WK1 For Each nm In .Names If CBool(InStr(1, nm.RefersTo, "#REF!", vbTextCompare)) Or _ CBool(InStr(1, nm.RefersTo, "#NAME?", vbTextCompare)) Then 'Debug.Print nm.Name On Error Resume Next nm.Delete Err.Clear On Error GoTo 0 ElseIf LCase(Left(nm.Name, 3)) = "wk1" And _ (CBool(InStr(1, nm.RefersTo, "wk1!", vbTextCompare)) Or _ CBool(InStr(1, nm.RefersTo, "'wk1'!", vbTextCompare))) Then dict.Item(Mid(nm.Name, 4)) = LCase(nm.RefersTo) ElseIf LCase(Left(nm.Name, 2)) = "wk" Then dict.Item(nm.Name) = LCase(nm.RefersTo) End If Next nm For w = 1 To Worksheets.Count With Worksheets(w) If LCase(.Name) <> "wk1" And Left(LCase(.Name), 2) = "wk" Then For Each k In dict If dict.exists(.Name & k) Then .Parent.Names(.Name & k).RefersTo = _ Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare) ElseIf Left(LCase(k), 2) <> "wk" Then .Parent.Names.Add _ Name:=.Name & k, _ RefersTo:=Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare) End If Next k End If End With Next w End With dict.RemoveAll: Set dict = Nothing 'MsgBox "All worksheets done" End Sub
请注意，这将创build/重新定义所有工作表上的所有命名范围（WK1除外）。 据我可以确定，唯一的机会有误报会有一个现有的命名范围与WK1wkrange （但这将是愚蠢的）的名称。
此代码工作
Public Sub CopyNamedRanges() Dim namedRange As Name Dim targetRefersTo As String Dim targetName As String On Error Resume Next For Each namedRange In ActiveWorkbook.Names If Left$(namedRange.RefersTo, 6) = "='Wk1'" And Left$(namedRange.Name, 3) = "Wk1" Then targetName = Replace(namedRange.Name, "Wk1", ActiveSheet.Name) targetRefersTo = Replace(namedRange.RefersTo, "Wk1", ActiveSheet.Name) ActiveWorkbook.Names.Add targetName, targetRefersTo ' Might error if it already exists ActiveWorkbook.Names(targetName).RefersTo = targetRefersTo namedRange.RefersToRange.Copy Range(targetName) ' Remove this line if it's not required End If Next End Sub
代码如何工作这部分If Left$(namedRange.RefersTo, 6) = "='Wk1'"确保范围引用表单上的一些称为Wk1的单元格另一个条件（Left $（namedRange.Name，3） =“Wk1”）也将匹配工作表Wk10 – Wk19上的命名范围。
这部分ActiveWorkbook.Names.Add targetName, targetRefersTo将添加一个新的命名范围，引用当前工作表上的单元格
这部分namedRange.RefersToRange.Copy Range(targetName)将Wk1工作表上命名范围的内容复制到当前工作表（如果不需要，则删除该行）
Dim RangeName As Variant尝试更改variablestypes