Question

我一直致力于让工作簿创建工作表并根据数据透视表中的值填充这些工作表。通过我的各种搜索，我已经能够使用与此类似的内容创建基于列表的工作表（信用于ccm.net上的rizvisa1）：

`Sub CreateSheetsFromAList()
    Dim nameSource      As String 'sheet name where to read names
    Dim nameColumn      As String 'column where the names are located
    Dim nameStartRow    As Long   'row from where name starts

    Dim detailSheet   As String 'sales detail sheet name
    Dim detailRange   As String 'range to copy from sales detail sheet

    Dim nameEndRow      As Long   'row where name ends
    Dim employeeName    As String 'employee name

    Dim newSheet        As Worksheet

    nameSource = "Pivot"
    nameColumn = "A"
    nameStartRow = 5

    detailSheet = "Pivot"

    'this is the range where I want to only copy and paste the rows/records that match the new sheet name
    detailRange = "A5:D463"


    'find the last cell in use
    nameEndRow = Sheets(nameSource).Cells(Rows.Count, nameColumn).End(xlUp).Row

    'loop till last row
    Do While (nameStartRow <= nameEndRow)
        'get the name
        employeeName = Sheets(nameSource).Cells(nameStartRow, nameColumn)

        'remove any white space
        employeeName = Trim(employeeName)

        ' if name is not equal to ""
        If (employeeName <> vbNullString) Then

            On Error Resume Next 'do not throw error
            Err.Clear 'clear any existing error

            'if sheet name is not present this will cause error to leverage
            Sheets(employeeName).Name = employeeName

            If (Err.Number > 0) Then
                'sheet was not there, so it create error, so we can create this sheet
                Err.Clear
                On Error GoTo -1 'disable exception so to reuse in loop

                'add new sheet
                Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))

                'rename sheet
                newSheet.Name = employeeName

                Application.CutCopyMode = False 'clear clipboard
                'copy sales detail
                Sheets(detailSheet).Range(detailRange).Copy

                'paste training material
                Sheets(employeeName).Cells(1, "A").PasteSpecial
                Application.CutCopyMode = False
            End If
        End If
        nameStartRow = nameStartRow + 1 'increment row
    Loop
End Sub`

这里唯一的问题是它我只是在复制静态范围。

我的问题是选择第一列与工作表名称匹配的范围，以便复制并粘贴到新创建的工作表中。我尝试使用For Each，其中一个单元格与工作表名称匹配并复制整行，但我们无法获得所需的结果。

这是我想要做的事情：

在数据透视表中使用包含以下数据的工作表： Pivot

然后将其转换为新的工作表，其中包含A列中的工作表名称，仅填充与工作表名称匹配的数据，如下所示：

New sheets with data

非常感谢您提供的任何帮助。

Answer 1

有两种方法。它在A列中包含工作表名称，然后您可以对工作表名称进行过滤，然后复制范围。在CCM上，您会找到该解决方案。基本上，您将复制第一列的不同值，以了解如何创建工作表。每个值的过滤器，然后复制到新的工作表中

Answer 2

以下内容应该有效（未经测试）。

Sub copyPivotRows()
Dim pivotRow as Range, wb as Workbook, pivotSheet as Worksheet, dataSheet as Worksheet
Dim strName as String, rowCount
Set wb = ActiveWorkbook
Set pivotSheet = wb.sheets("Pivot")
For each datasheet in wb.Sheets
    rowCount = 1
    For each pivotRow in pivotSheet.usedrange.rows
        if pivotRow.row > 1 then
            strName = pivotRow.cells(1).value
            if datasheet.name = strName then
                while (datasheet.rows(rowCount).cells(1).value <> "")
                    rowCount = rowCount + 1
                wend
                pivotRow.copy datasheet.rows(rowCount)
                Exit For
            end if
            set newSheet = wb.sheets.add(null,datasheet)
            newSheet.name = strName
        end if
    next 'row
next 'datasheet
End Sub

让我知道它是否不起作用以及错误是什么，我可以帮助/编辑以使其正常工作，现在就无法自己测试。

基于列表创建工作表，并仅填充列与工作表名称匹配的数据

2 个答案: