Excel按名称将工作表数据拆分为新的Excel工作簿

Question

Model   Place
model23 35372
model23 35372
model54 31034
model24 31034
model54 31034
model24 31034

我有这个Excel数据（数据更大是38000行+我可以在这里添加所有） 我想尝试2道路..

1）按名称模型拆分工作表（但我想要取名和模型并放置。

示例：

SheetName：model23

 Model    Place
    model23 35372
    model23 35372

2）如果我可以将地点值的范围从x到y的数字取出，然后将工作表拆分为此范围（例如：30000-40000）。

使用绿色框我想要取值并添加到模型或更好的新工作表，如果我可以制作新的Excel文件

Answer 1

请尝试以下操作，您的数据将拆分为新的Excel工作簿

新工作簿将保存在CurPath = ActiveWorkbook.Path & "\"

Option Explicit
Private Sub Split_Data_NewBooks()
    Dim Rng As Range
    Dim List As Collection
    Dim ListValue As Variant
    Dim i As Long
    Dim CurPath As String

    CurPath = ActiveWorkbook.Path & "\"

'   Set the Sheet Name
    With ThisWorkbook.Sheets("Sheet1")

        If .AutoFilterMode = False Then
            Range("A1").AutoFilter
        End If

        Set Rng = Range(.AutoFilter.Range.Columns(1).Address)

        Set List = New Collection

        On Error Resume Next
        For i = 2 To Rng.Rows.Count
            List.Add Rng.Cells(i, 1), CStr(Rng.Cells(i, 1))
        Next i
        On Error GoTo 0

        For Each ListValue In List

            Rng.AutoFilter Field:=1, Criteria1:=ListValue

    '       // Copy the AutoFiltered Range to new Workbook
            .AutoFilter.Range.Copy
             Workbooks.Add
             ActiveSheet.Paste
             ActiveWorkbook.SaveAs Filename:=CurPath & Left(ListValue, 30)
             Cells.EntireColumn.AutoFit
             ActiveWorkbook.Close savechanges:=True

        Next ListValue

        .AutoFilter.ShowAllData
        .AutoFilterMode = False
        .Activate
    End With

End Sub

Answer 2

根据你这样做的原因，我认为这个结果是不可取的。

通常，工作表太多的工作簿功能不是很好。

对于电子表格作者以外的任何人来说，很难找到你需要的东西。

不确定您的目的是什么，但几乎可以肯定会有更好的设计。

据说 0m3r 与你有联系。