Макрос создания ячеек в и из листа - PullRequest
Новая
       9

Макрос создания ячеек в и из листа

0 голосов
/ 05 января 2019

Я скопировал этот код для создания новых книг на основе расширенных фильтров. Он отбрасывает то, что должен, и создает более 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
...