在工作表和的宏创建单元格

时间:2019-01-05 12:44:18

标签: excel vba filter worksheet-function

我已复制此代码以基于高级过滤器创建新的工作簿。它做到了应有的工作,并创建了100多个工作簿,但是不幸的是,这导致我的主数据在单元格引用XFD(工作表的末尾)上有一个流氓列。我如何修改此代码以阻止其执行此操作?这意味着我不能再插入列

Sub ExtractToNewWorkbook()
    Dim ws     As Worksheet
    Dim wsNew  As Workbook
    Dim rData  As Range
    Dim rfl    As Range
    Dim CostCentre  As String
    Dim sfilename As String

    Set ws = ThisWorkbook.Sheets("data")
    'Apply advance filter in your sheet
    With ws
        Set rData = .Range(.Cells(1, 1), _
                           .Cells(.Rows.Count, 7).End(xlUp)) _
        .Columns(.Columns.Count).Clear
        .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)). _
                        AdvancedFilter Action:=xlFilterCopy, _ 
                        CopyToRange:=.Cells(1, .Columns.Count), _
                        Unique:=True

        For Each rfl In .Range(.Cells(1, .Columns.Count), _
                               .Cells(.Rows.Count, .Columns.Count).End(xlUp))
            CostCentre = rfl.Text
            Set wsNew = Workbooks.Add
            sfilename = CostCentre & ".xlsx"

            'Set the Location
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename
            Application.DisplayAlerts = False
            ws.Activate
            rData.AutoFilter Field:=1, Criteria1:=CostCentre
            rData.Copy
            Windows(CostCentre).Activate
            ActiveSheet.Paste
            ActiveWorkbook.Close SaveChanges:=True
        Next rfl
        Application.DisplayAlerts = True
    End With
    ws.Columns(Columns.Count).ClearContents
    rData.AutoFilter
End Sub

0 个答案:

没有答案