Kopieren benannte Bereiche in das aktive Blatt

Question

Ich versuche, benannte Bereiche aus dem Arbeitsblatt Wk1 in das aktive Blatt in der Arbeitsmappe zu kopieren.

Ich bekomme Fehlermeldungen, wenn ich den Code ausführen. Entweder wird ein Objekt nicht gesetzt oder eine Variable wurde nicht deklariert.

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 

Ive änderte den Code zu diesem. Ich bekomme keine Fehlermeldungen, aber der Code funktioniert immer noch nicht. Die benannten Bereiche kopieren nicht vom Blatt Wk1 in das Blatt Active. Das einzige, was passiert ist, dass die Message Box

Öffnet

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 

Answer 1

Dim RangeName As Variant Versuchen Sie den Variablentyp zu ändern

Answer 2

dauerte einige Zeit, mich um herauszufinden, was nicht funktioniert, wenn kein Fehler vorhanden ist, aber schließlich denke ich, ich es geschafft um das Problem herauszufinden.

Ersetzen Sie die folgende Zeile in Ihrem Code

HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2) 

zu:

HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address) 

Dies sollte Ihnen gewünschte Ergebnis.

Syntax für Zum Ziel kopieren ist Destination:=Worksheets("sheet_name").Range(range). Hier sollte Blattname der Name des Blattes sein. Also, wenn Sie schreiben Worksheets("cs.Name") Code sucht nach dem Blatt mit dem Namen cs.Name, die tatsächlich nicht existiert daher nur Worksheets(cs.Name) verwenden. Das zweite Ding hier ist der Bereich (nur um die Dinge besser zu erklären, verwende ich $ A $ 1: $ A $ 5 als Bereich). Wenn Sie .Range(RangeName2) schreiben, suchen Sie nach 'cs.Name'!$A$1:$A$5. Auch dies ist falsch, da der Bereich als .Range($A$1:$A$5) geschrieben werden soll. So wird .Range(HighlightRange.Address) Ihnen den richtigen Bereich geben.

Sie können auch in der Zeile RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'") spielen, um die richtige Adresse zu erhalten.

Hoffe, das hilft.

EDIT: __________________________________________________________________________________

Beispiel dafür, was ich will. den benannten Bereich Wk1Totalhrs von Wk1 Blatt Wk2-WK7 Blätter kopieren, so dass Wk1Totalhrs Wk2Totalhrs wird, Wk3Totalhrs usw. auf dem entsprechenden neuen Blatt

Versuchen Sie, den folgenden Code zu erreichen, was Sie als Ihre Anforderung in Kommentar erwähnt (oder wie oben).

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 

Answer 3

Ich denke, es ist genauso einfach wie das.

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 

Answer 4

^{Im nicht-Fehlermeldungen erhalten, aber der Code immer noch nicht funktioniert.}
_{Die angegebenen Bereiche kopieren nicht vom Blatt Wk1 in das Blatt Active.}

Die folgende Zeile wird Fehlalarme zurück, wenn der benannte Bereich mit startet oder enthält WK10, WK11 usw.

If InStr(1, RangeName, "Wk1", 1) > 0 Then 

Etwas weiter unten, führen Sie eine variable Eigenschaft zu zitieren; Dadurch wird eine Literalzeichenfolge und nicht der Wert der Variableneigenschaft erstellt.

Sie benötigen einen konkreteren Weg, um die definierten Namen auf WK1 zu identifizieren. Nachdem ich Ihr Problem genau betrachtet habe, glaube ich, dass Sie einen oder mehrere dynamische benannte Bereiche haben können, die durch Formeln definiert sind. Dies würde einige der "nicht funktionierenden" Verhalten Ihres Codes erklären, die mit konventionelleren Eigenschaften arbeiten sollten.

Es gibt auch das Problem, ob Sie den RefersTo: eines vorhandenen definierten benannten Bereichs neu schreiben oder einen neuen benannten Bereich hinzufügen sollten. Eine übliche Vorgehensweise besteht darin, einfach zu versuchen, den benannten Bereich un zu löschen und dann einen neuen zu erstellen. Ich habe diese Methode aus verschiedenen Gründen nie gemocht. Eine davon ist, dass das Löschen eines benannten Bereichs abhängige benannte Bereiche ergibt, die sich auf #REF! beziehen, und ich habe nie irrtümlicherweise angenommen, dass resume next 'best practice' ist.

Im Folgenden wird ein Wörterbuch mit Schlüsseln erstellt, die benannte Bereiche enthalten, die erstellt werden sollen, und solche, die bereits mit mehreren Kriterien existieren. Ich habe dies wiederholt auf eine Kombination von konventionellen und dynamischen benannten Bereichen mit Erfolg getestet.

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 

Beachten Sie, dass dies alle benannten Bereiche auf allen Arbeitsblättern (außer WK1) erstellt/neu definiert. So weit ich feststellen kann, wäre die einzige Chance, falsche Positive zu haben, eine existierende benannte Reihe mit einem Namen zu haben, der so etwas wie WK1wkrange ist (aber das wäre einfach albern).

Answer 5

arbeitet Dieser Code

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 

Wie der Code Dieser Teil If Left$(namedRange.RefersTo, 6) = "='Wk1'" stellt sicher, dass der Bereich bezieht sich auf einige Zellen auf dem Blatt namens Wk1 Die andere Bedingung (Left $ (namedRange.Name funktioniert , 3) = "Wk1") würde auch den benannten Bereichen auf den Blättern Wk10 - Wk19 entsprechen.

Dieser Teil ActiveWorkbook.Names.Add targetName, targetRefersTo Willen fügt einen neuen benannten Bereich, der auf dem Wk1 Blatt auf die aktuelle Folie (entfernen Sie die Zeile, wenn Sie

Dieser Teil namedRange.RefersToRange.Copy Range(targetName) kopiert den Inhalt des benannten Bereichs zu den Zellen auf dem aktuellen Blatt bezieht sich brauche es nicht)