如何将数据粘贴到新的工作表中，并基于另一个表中的单元格删除某些行?

I have data in an Excel spreadsheet called "Master" of about 1,000 rows I am trying to split into 42 different spreadsheets based on an identifier called the Region ID. I have created a table with the 42 unique different regions in another spreadsheet in the same workbook, along with what I want to name the new worksheets. I have the following code so far, which creates the 42 new spreadsheets and names them accordingly.

我在Excel电子表格的数据称为“大师”约1000行我想分为42个不同电子表格基于一个标识符称为区域ID。我已经创建了一个表42独特的不同区域在另一个电子表格在同一工作簿,连同我想新工作表的名称。到目前为止，我有以下代码，它创建了42个新的电子表格并相应地命名它们。

Sub Create_Tabs()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("TabList").Range("D2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
    Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
    'I would like to create code here to paste the "Master" spreadsheet contents in the newly created worksheet and keep only rows corresponding Region IDs (delete the rest).
Next MyCell
End Sub

How do I paste the "Master" spreadsheet contents in the newly created worksheet and keep only rows corresponding Region IDs (delete the rest)?

如何在新创建的工作表中粘贴“Master”电子表格内容，并只保留相应的行区域id(删除其余的)?

1 个解决方案

#1

Filter your master data on tab names and copy them over to the new sheet.

筛选标签名上的主数据，并将其复制到新表中。

Something like this will work. You might need to change your filter field based on your data.

像这样的东西可以用。您可能需要根据数据更改过滤器字段。

Sub Create_Tabs_And_Copy_Data()
    Dim MyCell As Range, MyRange As Range

    Set MyRange = Sheets("TabList").Range("D2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
        'I would like to create code here to paste the "Master" spreadsheet contents in the newly created worksheet and keep only rows corresponding Region IDs (delete the rest).
         With Sheets("Master").UsedRange
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=MyCell.Value
            .SpecialCells(xlCellTypeVisible).Copy Sheets(MyCell.Value).Cells(1, 1)
            Application.CutCopyMode = False
        End With
    Next MyCell
    End Sub

#1