Question

我想从电子表格中的每个标签中复制数据并将其另存为新工作簿。原始工作簿有许多选项卡（大约50个），其中一个选项卡设置为宏来运行数据，因为将来可能会添加新选项卡。宏数据选项卡包含每个新工作簿的文件位置，选项卡的名称以及另一个宏用于将这些新创建的工作簿通过电子邮件发送给相关方的一些信息。

问题是让宏识别用于查找要复制的范围的选项卡名称，因为选项卡名称列在单元格中。我不确定是否可以使用此列表，或者是否在末尾添加工作表以循环显示从指定起始位置的所有工作表，直到具有if的那个工作表。

Values

Answer 1

这样的事情对你有用。请注意以下事项：

代码假设在工作表“email”上它有一个标题行，即第1行，实际数据从第2行开始。
检查B列单元格是否为工作簿中的有效工作表名称

我已经验证此代码可以根据原始帖子正常运行：

Sub Datacopy()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsTemp As Worksheet
    Dim rSheetNames As Range
    Dim rSheet As Range

    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("email")

    Set rSheetNames = wsData.Range("B2", wsData.Cells(Rows.Count, "B").End(xlUp))
    If rSheetNames.Row < 2 Then Exit Sub    'No data

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    For Each rSheet In rSheetNames
        If Not Evaluate("ISERROR('" & rSheet.Text & "'!A1)") Then
            Set wsTemp = Sheets.Add
            Sheets(rSheet.Text).Range("A1:L500").Copy
            wsTemp.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
            wsTemp.Range("A1").PasteSpecial xlPasteComments
            wsTemp.Move
            ActiveWorkbook.SaveAs rSheet.Offset(, 3).Text
            ActiveWorkbook.Close False
        End If
    Next rSheet

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

    MsgBox "Finished making files!"

End Sub

根据单元格值中的选项卡名称将副本循环到多个选项卡中的新工作簿功能

1 个答案: