Need VBA for Schleife Verweis auf einen benannten Bereich, der alle Blattnamen enthält

Question

Ich habe einen "rohen" Code, der einige Daten von einem Blatt zu einem anderen kopiert, und der Blattname, von dem die Daten kopiert werden, gefunden werden kann in einer Zelle. Die Anzahl der Blätter wächst jedoch, und ich habe einen dynamischen benannten Bereich für die Blattnamen erstellt und möchte den folgenden Code für alle Blätter im dynamischen Bereich ausführen. Mein Code sieht wie folgt aus:

Calculate 

' get the worksheet name from cell AA3 
Worksheets(Range("AA3").Value).Activate 

' Copy the data 
Range("A1:A1500").Select 
Selection.Copy 

' Paste the data on the next empty row in sheet "Artiklar" 
Sheets("Artiklar").Select 
Dim NextRow As Range 
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0) 
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 

Nun, ich möchte so etwas wie eine Schleife mit Bezug auf den dynamischen Bereich haben, aber ich bin nicht in der Lage, es zu bekommen zu arbeiten, wie VBA wirklich nicht mein Ding ist .. Anstatt AA3, AA4 usw. zu referenzieren, möchte ich auf den benannten Bereich verweisen, der die Daten von AA3, AA4 ... AAx enthält. Der benannte Bereich enthält möglicherweise auch leere Zellen, da dies das Ergebnis einer Array-Formel in AA3 .... AA150 ist.

Vielen Dank! /Fredrik

Answer 1

Das folgende Beispiel Schleifen durch jede Zelle in einem benannten Bereich von einer Verwendung For Each ... Next-Schleife. Wenn der Wert einer Zelle im Bereich den Wert von Limit überschreitet, wird die Zellenfarbe in gelb geändert.

vba 
Sub ApplyColor() 
    Const Limit As Integer = 25 
    For Each c In Range("MyRange") 
     If c.Value > Limit Then 
      c.Interior.ColorIndex = 27 
     End If 
    Next c 
End Sub 

Source

So könnte man mit so etwas wie dies beginnen:

Calculate 

Dim NextRow As Range 

' get a range object from the named range 
For Each c In Range("[File.xls]Sheet1!NamedRange") 

    ' Copy the data 
    Worksheets(c.Value).Range("A1:A1500").Copy 

    ' Paste the data on the next empty row in sheet "Artiklar" 
    Sheets("Artiklar").Activate 
    Set NextRow = Range("A65536").End(xlUp).Offset(1, 0) 
    NextRow.PasteSpecial xlPasteValues 

Next c 

Sie werden bemerken, dass ich ein bisschen mehr explizit mit war, wie der benannte Bereich bezeichnet wird zu - die Anforderung hier könnte variieren, je nachdem, wie Sie den Bereich für den Anfang deklariert haben (was sein Umfang ist), aber die Art, wie ich es getan habe, wird höchstwahrscheinlich für Sie arbeiten. Weitere Informationen zum Umfang der benannten Bereiche finden Sie im verknüpften Artikel.

Answer 2

Der folgende Code sollte für Sie arbeiten. Ich nahm an, dass der benannte Bereich (ich nannte es Copysheets) in der aktiven Arbeitsmappe (Scope-Arbeitsmappe) ist.

Sub copySheets() 

Dim sheetName As Range 
Dim copyRange As Range 
Dim destinationRange As Range 

For Each sheetName In Range("copysheets") 

    If sheetName.Value <> "" And sheetName.Value <> 0 Then 

    Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")  
    Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 

    copyRange.Copy 
    destinationRange.PasteSpecial xlPasteValues 

    End If 

Next 

End Sub 

Answer 3

Dim myNamedRng as Range, cell as Range 
'... 
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range 
With Sheets("Artiklar") 
    For Each cell In myNamedRng 
     If cell.Value <>"" Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value 
    Next cell 
End With 

Answer 4

- = Problem gelöst = -

Vielen Dank an alle auf meine Frage für Ihren Beitrag! Alle Antworten, die ich erhielt, haben mir geholfen, meinen Code zu verfeinern, der jetzt richtig funktioniert!

Grüße, Fredrik