根据列表创建工作表并仅填充数据，其中列与工作表名称匹配

Question

我一直在努力让工作簿创建工作表并根据数据透视表中的值填充这些工作表。通过我的各种搜索，我已经能够使用基于与此类似（信贷rizvisa1上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` 

这里唯一的问题是，它只是我已经一直在复制一个静态范围。

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

这里就是我想要做的事：

取片在枢轴表中的下列数据： Pivot

，并与A列中的工作表名称，人口稠密把它变成新的表仅与该工作表名称相匹配这样的数据：

New sheets with data

你可以提供任何帮助将不胜感激。

Answer 1

像下面这样的东西应该工作（未测试）。

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 

让我知道，如果它不能正常工作，并且错误是什么，我可以帮/编辑，使其工作，只是不能测试它自己现在。