Question

我有一段“粗略”代码，它将一些数据从一个工作表复制到另一个工作表，并且可以在一个单元格中找到复制数据的工作表名称。但是，工作表的数量正在增加，我已经为工作表名称创建了一个动态命名范围，并且希望为动态范围内的所有工作表执行以下代码。我的代码如下所示：

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

现在，我希望有一个类似于动态范围的循环，但我无法让它工作，因为VBA真的不是我的一杯茶...所以，而不是参考AA3，AA4等我想参考包含AA3，AA4 ...... AAx数据的命名范围。命名范围也可能包含空白单元格，因为它是AA3中的数组公式的结果.... AA150。

谢谢！ /弗雷德里克

Answer 1

以下示例循环遍历命名范围中的每个单元格使用For Each ... Next循环。如果范围内任何单元格的值超过Limit的值，单元格颜色变为黄色。

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

所以你可以从这样的事情开始：

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

你会注意到我对如何引用命名范围更加明确 - 这里的要求可能会有所不同，具体取决于你如何声明范围开始（范围是什么），但是我这样做的方式很可能对你有用。有关命名范围范围的更多信息，请参阅链接的文章。

Answer 2

以下代码应该适合您。我假设命名范围（我称之为copysheets）位于活动工作簿（范围工作簿）中。

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

- =解决了问题= -

谢谢大家对我的问题的贡献！我收到的所有答案都帮助我改进了我的代码，现在它正常运行！

此致弗雷德里克

需要VBA for循环引用包含所有工作表名称的命名范围

4 个答案: