Question

我需要将PT / Raw（以百万计）数据划分为多个工作表（基于员工 - 约1000）。我使用附加的代码和示例文件来满足我的要求。但是，现有代码本身并不创建工作表，但是我有1000名学生，所以我想通过代码创建尽可能多的工作表，因为有学生。因为我是VB的新手，所以真的不确定要改变哪个部分。我在线获取代码来创建工作表，但不知道如何将其插入原始文件中。任何帮助都会有所帮助。下面是将原始数据划分为已存在的多个工作表的代码：

Sub copyPasteData()

Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long

strSourceSheet = "Data entry"

Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select

Range("C2").Select
Do While ActiveCell.Value <> ""
    strDestinationSheet = ActiveCell.Value
    ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select
    Selection.Copy
    Sheets(strDestinationSheet).Visible = True
    Sheets(strDestinationSheet).Select
    lastRow = LastRowInOneColumn("A")
    Cells(lastRow + 1, 1).Select
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Sheets(strSourceSheet).Select
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Offset(1, 0).Select
Loop
End Sub


Public Function LastRowInOneColumn(col)

Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function

下面是创建多个工作表的代码

Sub AddSheets()


Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook

Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
 For Each cell In wsWithSheetNames.Range("A2:A5")
    With wbToAddSheetsTo
      .Sheets.Add after:=.Sheets(.Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = cell.Value
    If Err.Number = 1004 Then
      Debug.Print cell.Value & " already used as a sheet name"
    End If
    On Error GoTo 0
  End With
  Next cell
End Sub

Answer 1

创建数千个工作表以便将数据子集通过电子邮件发送给特定人员将是一种糟糕的方法。而是使用数据透视表来过滤数据，然后通过电子邮件发送过滤后的数据集。

如果您按人员过滤数据透视表，请使用VBA循环浏览人员列表，将数据透视表复制到电子邮件，发送和循环。根据您的数据，您甚至可能不需要数据透视表，只需要根据学生姓名查找内容的报告表。

但是，我不会为你编写代码。您可以在特定于数据透视表的VBA上找到资源，并在Ron de Bruin's site.

上找到来自Excel的任何电子邮件内容。

如何将数据透视表/原始数据分成多个工作表

1 个答案: