Loops VBA:“；对于每一个“；循环选择：根据选择中的位置复制某些单元格

我会尽量简短地解释

我有一套文件。每个文件中都有一个至少有两列的工作表。第一列包含描述，第二列（和后面的）包含值（在我的例子中是字符串）。大多数文件只有两列。但是，有些数据库有两个以上的列

我编写了第一个循环，检查列表文件中的第三列是否为空。如果为空，则该文件只有两列，将被跳过。Elsewise（如果有两列以上），则运行一个子例程将工作表拆分为仅包含两列的单个文件

需要知道的重要一点是，每列包含项目信息，第一行包含项目名称

我的想法是选择第二列之后第一行中的单元格（例如，C1到E1；列数可能不同），然后对该选择的每个循环运行另一个

我创建了一个空的项目描述文件。根据循环的位置（如果它位于C1或D1或E1），我需要宏来复制相应单元格下方的单元格（例如，如果循环位于C1，则应复制C2:C10），并将其粘贴到空项目描述文件中的固定位置

当前进展

Sub sorter()

Dim mrunner As Workbook
Dim currentwb As Workbook
Dim FileNames As Variant

ThisWorkbook.Activate
Set mrunner = ActiveWorkbook

Range("A:A").Select

For Each FileNames In Selection

    Workbooks.Open Filename:=ThisWorkbook.Path & "\old\" & FileNames & ".xlsx"

    Set currentwb = ActiveWorkbook

    If Range("C2") = 0 Then

    currentwb.SaveAs Filename:=ThisWorkbook.Path & "\new\" & FileNames & ".xlsx"
    currentwb.Close

    Else

    Call splitter(currentwb,mrunner)

    End If

Next FileNames

End Sub


Sub splitter(currentwb,mrunner)

Dim basewb As Workbook
Dim newwb As Workbook
Dim subname As Variant
Dim master As Range
Dim segment As Range
Dim triggers As Range

Range("C2").Select
Range(ActiveCell, Cells(ActiveCell.Row, Columns.Count)).Select

For Each subname In Selection

    Set master = Range("B1")
    Set segment = Range(currentwb.Cells(subname.Column, 2), currentwb.Cells(subname.Column, 3))
    Set triggers = Range(currentwb.Cells(subname.Column, 4), currentwb.Cells(subname.Column, 43))

    ' save in new worksheet

    Workbooks.Open Filename:=mrunner.Path & "\RisikoTriggerReport_base.xlsx"

    Set newwb = ActiveWorkbook

    Range("B1") = master
    Range("B2") = segment
    Range("B5") = triggers

    newwb.SaveAs Filename:=mrunner.Path & "\new\" & subname & ".xlsx"
    newwb.Close

 Next subname
 currentwb.close

 End Sub

如果代码是这样的，则宏运行时不会出现任何错误。然而

    Set master = Range("B1")
    Set segment = Range(Cells(subname.Column, 2), Cells(subname.Column, 3))
    Set triggers = Range(Cells(subname.Column, 4), Cells(subname.Column, 43))

工作不正常。第一行可用，但其他两行不可用。变量段和触发器保持为空

我试着参考一份工作表。所以我的代码看起来像这样

    Set master = currentwb.Range("B1")
    Set segment = currentwb.Range(currentwb.Cells(subname.Column, 2), currentwb.Cells(subname.Column, 3))
    Set triggers = currentwb.Range(currentwb.Cells(subname.Column, 4), currentwb.cCells(subname.Column, 43))

但这返回了一个错误。我的想法有什么错误？（试图将范围链接到特定工作簿？
您的变量子名称实际上是一个范围

当在每个子名称的
中成为第一个单元格时，第二个单元格

只需根据subname的列设置part2。由于
column
返回一个数字，表示法将有所不同：

Dim subname As Range
...
For Each subname In Selection

    Set part1 = currentwb.Range("B1:B3") ' Exists only once in each file 
                                     ' so I can fix the range
    Set part2 = currentwb.Range(currentwb.Cells(subname.Column, 1), currentwb.Cells(subname.Column, 10))
...
Next subname

顺便问一下，currentwb实际上是一个工作表吗？你需要在工作表上调用
Range
，不是吗？
嗨。谢谢你的回答。关于你的第一条评论：变量subname应该包含循环运行的项目名（数字和字母的组合）不是单元格。我仍然将其定义为范围吗？其次，currentwb是我在第一个循环中定义的工作表。我刚刚醒来，现在将尝试将宏组合在一起。@user3648111当您循环通过
选择时，每次都会得到一个范围。正如您声明的
子名称作为变量一样，这不是问题。
currentwb
只是这个名字误导了我，非常感谢你的意见。我已经在下面发布了我的完整代码。我想我很快就能让宏正常工作了。但是仍然存在一些问题。当你有其他问题时，你需要在这里打开一个新问题，或者更新现有问题（如果是次要问题）。无论如何，不要把它放在这里t在回答中请注意，我不知道。我已经删除了第二个答案并更新了我的问题帖子。正如我所说的，代码被接受了，但没有带来预期的结果。在我运行宏之后，我确实拥有所有文件名都正确的文件（这意味着变量subname工作正常），但是新创建的工作簿（newwb）在单元格B1中只有正确的值。单元格B2到B43为空。（我故意跳过了B4）