Данные с одого листа разбить на несколько листов кнопкой

Автор lelicol, 10.12.2014, 00:16

« назад - далее »

lelicol

ДД!Есть таблица с данными (в примере кол-во строк и столбцов минимально, фактически столбцов больше 10, строк более 5000).Помогите написать макрос, чтобы одной кнопкой разбить данные по фактическому наличию- каждое место было на отдельном листе с названием этого места.Кол-во строк и столбцов может меняться.Необходимо для подготовки инвентаризационных описей, просто из описи укажу ссылки на эти страницы, используя формулы. Спасибо.

GWolf

Доброго дня!
Ну, как-то так:
Sub toSheets()
    Dim nR As Long
    Dim nShe As Worksheet
    Dim nmWS As String
   
    nR = 2
    With ThisWorkbook
        Do
   
            Set nShe = Sheets.Add(After:=Worksheets(Worksheets.Count))
            With .Sheets("Общее")
                nmWS = .Cells(nR, 2).Text & " (" & .Cells(nR, 1).Text & ")"
                nShe.Name = nmWS
            End With
           
            Set nShe = Nothing
           
            nR = nR + 1
        Loop While .Sheets("Общее").Cells(nR, 1).Text <> ""
    End With
    nR = 0
End Sub
Путей к вершине - множество. Этот один из многих!

lelicol

#2
Цитата: GWolf от 10.12.2014, 16:17
Доброго дня!
Ну, как-то так:
....
Спасибо за ответ. Суть поняла, попробую исправить под себя. Правильно пишут администраторы, что надо точнее выражать, что необходимо сделать. :) Поясню, мне надо было чтобы на листы разбросалось "по фактическому наличию".,т.е. не каждое наименование на отдельном листе, а каждый "магазин" на отдельном листе и в нем таже таблица только с данными для этого "магазина".
Естетсвенно выдает ошибку, что не могут быть листы с одинаковым названием. Пытаюсь исправить, нужна помощь.

GWolf

#3
Цитата: lelicol от 10.12.2014, 19:34
... надо было чтобы на листы разбросалось "по фактическому наличию".,т.е. не каждое наименование на отдельном листе, а каждый "магазин" на отдельном листе ...

Доброго дня!
Ну как то так:
Sub toSheetsShop()
    Dim nR As Long
    Dim nShe As Worksheet
    Dim nmShp1 As String, nmShp2 As String
    Dim flg As Boolean
    Dim i As Integer
   
    nR = 2
    With ThisWorkbook
        Do
            With .Sheets("Общее")
                nmShp1 = .Cells(nR, 1).Text
            End With
           
            i = 0
            flg = False
            For i = 1 To .Sheets.Count
                If .Sheets(i).Name = nmShp1 Then
                    flg = True
                    Exit For
                End If
            Next i
           
            If flg = False Then
                Set nShe = Sheets.Add(After:=Worksheets(Worksheets.Count))
                With .Sheets("Общее")
                    nShe.Name = nmShp1
                End With
                ' здесь транслируем данные во вновь созданный лист магазина
                Set nShe = Nothing
            Else
                'ну а здесь мы работаем по трансляции информации в уже имеющийся лист магазина.
            End If
           
            nR = nR + 1
        Loop While .Sheets("Общее").Cells(nR, 1).Text <> ""
    End With
    nR = 0
End Sub
макрос проверяет список ранее созданных листов, т.о. если один и тот же магазин будет указан в разных, расположенных не подряд строках он эт о отследит ...
Путей к вершине - множество. Этот один из многих!

lelicol

Спасибо за помощь! Исправила, все работает. Теперь работаю дальше:-) Задача гораздо сложнее, если ничего не получится буду вновь консультироваться. ;)

GWolf

Цитата: lelicol от 14.12.2014, 16:08
... Задача гораздо сложнее, если ничего не получится буду вновь консультироваться. ;)
Ну, к сложностям нам не привыкать. Обращайтесь. Удачи.
Путей к вершине - множество. Этот один из многих!