Цитата |
---|
Vintic написал: Правда перед каждым новым запуском надо удалять все вкладки "Таблица". |
Их можно удалить в начале процедуры. Но на сколько я понимаю, ТС нужно изменение по вводу текста в ячейку, а не удалять листы.
minpower, Может Вам посмотреть в сторону UserForm, и на форме реализовать настройку фильтров и повесить на кнопку распределение данных по таблицам.
Немного переделал Ваш макрос, но не думаю что это подойдет.
Скрытый текст |
---|
Код |
---|
Sub copy()
Dim i&, iarr(), j&, k&, l&
Dim arr(), sht As Worksheet, sh As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
arr = Worksheets("настройки").[a1].CurrentRegion.Value
For i = 1 To UBound(arr)
On Error Resume Next
Set sh = ThisWorkbook.Worksheets(arr(i, 1))
If Not sh Is Nothing Then sh.Delete
On Error GoTo 0
k = 0
Set sht = Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count))
With sht
.Name = arr(i, 1)
.[a1].Resize(, 3) = Array("Название", "Вес", "Габариты")
iarr = Worksheets("данные").[a1].CurrentRegion.Value
For j = 1 To UBound(iarr)
If UCase(iarr(j, 1)) = UCase(arr(i, 2)) Then
k = k + 1
For l = 1 To UBound(iarr, 2)
iarr(k, l) = iarr(j, l)
Next l
End If
Next j
If k > 0 Then .[a2].Resize(k, UBound(iarr, 2)).Value = iarr Else .Delete
End With
Next i
Worksheets("настройки").Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
|