Я пытаюсь разделить мою книгу Excel на несколько книг, но у меня проблема с кодом - PullRequest
0 голосов
/ 01 октября 2019

Я работаю для некоммерческой организации, которая проводит мероприятия. Мне дали большой список владельцев регистрации, каждый из которых принадлежит к определенной команде. Я пытаюсь разделить мою большую рабочую книгу на отдельные рабочие книги для каждой команды.

Мне дали код, который, как мне сказали, работал в прошлом, но у меня есть некоторые проблемы с ним. Вот сам код.

Sub ParseItems ()

'Джерри Бокер (22.04.2010)

' На основе выбранного столбца данные фильтруются в отдельные рабочие книги

книги названы по значению плюс сегодняшняя дата

Dim LR As Long, Itm Long, MyCount As Long, vCol As Long

Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

'Лист с данными в нем

Set ws = Sheets ("Sheet1")

' Путь для сохранения файлов, запомните окончательный \

SvPath = "G:\AWNY\NW 2015\Teams\Post DOE\Interim Rosters\” "

'Диапазон, в котором заголовки располагаются в верхней части данных, в виде строки, данные ДОЛЖНЫ

' иметь заголовки в этой строке, отредактируйте в соответствии с языком вашей страны

vTitles = "A1:AB1"

'Выберите столбец для оценки, столбец A = 1, B = 2 и т. Д.

vCol = Application.InputBox ("По какому столбцу разделить данные?" & VbLf & vbLf & "(A = 1,B = 2, C = 3 и т. Д.), «Какой столбец?», 1, Тип: = 1)

Если vCol = 0, то Exit Sub

'Найти нижнюю строку данных

LR = ws.Cells (ws.Rows.Count, vCol) .End (xlUp) .Row

'Ускорить выполнение макроса

Application.ScreenUpdating = False

' Получить временный список уникальных значений из столбца A

ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Сортировать временный список

ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

' Поместить список в массив для циклов (значения не могут быть результатом формул, должны быть константами)

MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'очистить временный список рабочих листов

ws.Range("EE:EE").Clear

' Включите автофильтр, все, что нужно - только один столбец

ws.Range(vTitles).AutoFilter

'Прокрутите список по одному значению за раз

For Itm = 1 To UBound(MyArr)

    ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)



    ws.Range("A1:A" & LR).EntireRow.Copy

    Workbooks.Add

    Range("A1").PasteSpecial xlPasteAll

    Cells.Columns.AutoFit

    MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1



    ActiveWorkbook.SaveAs SvPath & MyArr(Itm), 51

    ActiveWorkbook.Close False



    ws.Range(vTitles).AutoFilter Field:=vCol

Next Itm

'Очистка

ws.AutoFilterMode = False

MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"

Application.ScreenUpdating = True

Конец Sub

У меня проблема в том, что когда я запускаю код, и он предлагает мне ввести столбец, который я хочу разделитьданные по. Я ввожу «1» (названия команд указаны в столбце «А»), и он говорит мне, что у меня есть «Ошибка времени выполнения:« 1004 »» и что «она не может быть применена к выбранному диапазону. Выберите одну ячейку в диапазоне»и попробуй еще раз".

Я не уверен, что делать, чтобы это исправить, и буду признателен за любой совет! Спасибо!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...