Vba 循环浏览工作表上的列，将数据复制到新工作簿中的新工作表-im卡住

我有一个工作簿，它由多个具有相同列标题的工作表组成。每个工作表中的行标识员工任务和其他任务信息。从AB开始的列-如果员工协助该任务，则应包含员工的标题作为列名以及行中的电子邮件地址。如果员工名单未涉及该任务，则某些行位于特定列中

我期待着做以下事情

为要添加的新工作表创建新工作簿 循环执行AB:BE并在新工作簿中创建一个新工作表，列标题名称作为工作表名称 筛选此列（示例：AB），使其仅包含此列表中的数据，而不包含空白 将此列数据（以AB为例）复制到此新工作表中 同时将B、F、H行从原始工作表复制到此新工作表 清除主工作表上的过滤器

循环到下一列（示例AC），在工作簿中重复创建新工作表

我在过去的行中做得很好——我在概念上思考这应该如何工作

---

有人举过例子吗？我在谷歌搜索了几天，在某些方面可以接近，但它不能很好地扩展/循环数据

注意：这也可以通过高级过滤器完成。允许将筛选的范围复制到新图纸

我不确定我是否完全理解了工作表的布局，但这里有一些基本代码，可以为每个列AB创建一个新工作表：BE，然后为列AB中的每一行（不是空的），将该单元格值以及列B、F和H中的值复制到新工作表中的一行。然后对列AC:BE重复此操作

Sub CopyRoles()

Dim nSheet As Integer
Dim nTasks As Integer
Dim nSourceRow As Long
Dim nDestRow As Long
Dim wkb As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet

Set wksSource = ActiveSheet
Set wkb = Workbooks.Add
For nTasks = wksSource.Range("AB1").Column To wksSource.Range("BE1").Column
    nSheet = nTasks - wksSource.Range("AB1").Column + 1
    With wkb.Sheets
        If .Count < nSheet Then    ' Checks if sheet count on wkb exceeded
            Set wksDest = .Add(after:=.Item(.Count), Type:=xlWorksheet)
        Else
            Set wksDest = .Item(nSheet)    ' Keeps from having empty sheets
        End If
        wksDest.Name = wksSource.Cells(1, nTasks)
    End With

    With wksSource
        wksDest.Cells(1, 1) = "E-mail address"  ' Add header row to sheet
        wksDest.Cells(1, 2) = .Cells(.UsedRange.Row, 2)   ' Col B
        wksDest.Cells(1, 3) = .Cells(.UsedRange.Row, 6)   ' Col F
        wksDest.Cells(1, 4) = .Cells(.UsedRange.Row, 8)   ' Col H
        nDestRow = 2
        For nSourceRow = .UsedRange.Row + 1 To .UsedRange.Rows.Count
            If .Cells(nSourceRow, nTasks).Value <> "" Then
                wksDest.Cells(nDestRow, 1).FormulaR1C1 = _
                    .Cells(nSourceRow, nTasks).Value
                wksDest.Cells(nDestRow, 2).FormulaR1C1 = _
                    .Range("B" & nSourceRow).Value
                wksDest.Cells(nDestRow, 3).FormulaR1C1 = _
                    .Range("F" & nSourceRow).Value
                wksDest.Cells(nDestRow, 4).FormulaR1C1 = _
                    .Range("H" & nSourceRow).Value
                nDestRow = nDestRow + 1
            End If
        Next nSourceRow
    End With
Next nTasks

wkb.SaveAs

End Sub

子复制角色（）
Dim nSheet为整数
将NTASK设置为整数
暗源与长源相同
黯淡的恩德斯特罗一样长
将wkb设置为工作簿
将wksSource设置为工作表
Dim wksDest As工作表
设置wksSource=ActiveSheet
设置wkb=工作簿。添加
对于nTasks=wksSource.Range（“AB1”）列到wksSource.Range（“BE1”）列
nSheet=nTasks-wksSource.Range（“AB1”）。列+1
用wkb
If.Count

如果您对行进行了操作，也可以对列进行操作。只需使用偏移函数在行上移动即可。或者使用范围（.cells（1,1），.cells（10,10））按数字引用列