Страницы: 1
RSS
Нужно раскидать таблицу по листам по значениям одного из столбцов
 
Всем привет! Задача такая: нужно раскидать таблицу по значениям одного из столбцов.
Дело в том, что у меня есть настройка PLEX, но файл делается для тех, у кого её нет и не будет. А им придётся регулярно "раскидывать" таблицу при обновлении данных. Поэтому PLEX отпадает.
Кроме того, нужно, чтобы из умной таблицы, которая сама по себе родилась из запроса PowerQuery, выходили умные таблицы. В идеале, конечно, ссылки PowerQuery на эту таблицу, но хотя бы просто умные таблицы.
Помогите, плиз, а то уже голова взрывается.
Разделить нужно по значению в столбце "Завод".
Где-то уже была похожая тема. Но у меня не сработал макрос. Ну там и задача чуть другая была.  
 
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=138186&...
 
Цитата
нужно раскидать таблицу по значениям одного из столбцов
Что значит раскидать?
внятнее
 
Александр Моторин,  по ссылке 2 сообщения все подробно расписано.
 
Цитата
Marat Ta написал:
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=138186&...
Пробовал, ошибку выдаёт
 
Мне в самом идеале прям создать бы на каждый завод по запросу Power Query. Но вручную задолбаешься.
 
Excelopfer, написал
Цитата
Пробовал, ошибку выдаёт
Попробуйте еще раз
Код
Sub iCopyZavod()
Dim i As Long
Dim n As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Dim iLastCol As Integer
Dim iLastRow As Long
Application.ScreenUpdating = False
  Application.DisplayAlerts = False
    For Each Sht In ThisWorkbook.Worksheets  'удаляем все листы, кроме "3054"
      If Sht.Name <> "3054" Then Sht.Delete
    Next
  Application.DisplayAlerts = True
    iLastCol = 19
  Set Sht = ThisWorkbook.Worksheets("3054")
   iLastRow = Cells(Rows.Count, 6).End(xlUp).Row
        Columns(iLastCol + 2).ClearContents
    Range(Cells(3, 6), Cells(iLastRow, 6)).AdvancedFilter Action:=xlFilterCopy _
                                  , CopyToRange:=Cells(1, iLastCol + 2), Unique:=True
        n = Cells(Rows.Count, iLastCol + 2).End(xlUp).Row
    For i = 2 To n          'цикл по уникальным значениям выбранного столбца
        Criterij = Sht.Cells(i, iLastCol + 2)
        iName = Criterij    'имя нового листа
       Sht.Range(Sht.Cells(3, 1), Sht.Cells(iLastRow, iLastCol)).AutoFilter 6, Criterij
        Sht.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        With Worksheets.Add(After:=Worksheets(Worksheets.Count))  'добавляет новый лист в конец
          .Range(.Cells(1, 1), .Cells(1, iLastCol)).PasteSpecial xlPasteColumnWidths
'          .Range(.Cells(1, 1), .Cells(1, iLastCol)).PasteSpecial xlPasteFormats
          .Range(.Cells(1, 1), .Cells(1, iLastCol)).PasteSpecial xlPasteValues
         Sht.AutoFilter.Range.AutoFilter
          .Name = iName
          .Range("A1").Select
        End With
    Next
Application.ScreenUpdating = True
   Sht.Activate
   Columns(iLastCol + 2).ClearContents
End Sub
 
Excelopfer, ...а вы так себе товарищ ни ответа ни привета

https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=139221&a...
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, извините, пока не успел попробовать. Вот эту задачку подкинули(((
Страницы: 1
Наверх