Create sheets based on a list and populate with data where a column matches the sheet name

1
votes

I've been working on a workbook to create and populate sheets based on values in a pivot table.

I create sheets based on the list using something similar to this (credit to rizvisa1 on ccm.net):

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

I've only been copying a static range.

My issue is selecting the range where the first column matches the sheet name in order to copy and paste into the newly created sheet. I've tried using For Each where a cell matches the sheet name and copying the entire row.

Here's what I'm trying to do:

Take a sheet with the following data in a pivot table: Pivot

And turn it into new sheets with the sheet names from column A, populated with only the data that matches the sheet name like this:

New sheets with data
enter image description here

2
excelvba

2 Answers

1
votes

There are couple of ways. It column A, contains the sheet name, then you can do the filter on sheet name, and then copy the range. On CCM, you would find that solution. Bascially you would copy the distinct value of first column, to know how what sheets to create. The filter for each value and then copy to the new sheet

0
votes

Something like the following should work (not tested).

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

let me know if it doesn't work and what the errors are and I can help/edit to make it work, just can't test it myself right now.