ДД!Есть таблица с данными (в примере кол-во строк и столбцов минимально, фактически столбцов больше 10, строк более 5000).Помогите написать макрос, чтобы одной кнопкой разбить данные по фактическому наличию- каждое место было на отдельном листе с названием этого места.Кол-во строк и столбцов может меняться.Необходимо для подготовки инвентаризационных описей, просто из описи укажу ссылки на эти страницы, используя формулы. Спасибо.
Доброго дня!
Ну, как-то так:
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
Цитата: GWolf от 10.12.2014, 16:17
Доброго дня!
Ну, как-то так:
....
Спасибо за ответ. Суть поняла, попробую исправить под себя. Правильно пишут администраторы, что надо точнее выражать, что необходимо сделать. :) Поясню, мне надо было чтобы на листы разбросалось "по фактическому наличию".,т.е. не каждое наименование на отдельном листе, а каждый "магазин" на отдельном листе и в нем таже таблица только с данными для этого "магазина".
Естетсвенно выдает ошибку, что не могут быть листы с одинаковым названием. Пытаюсь исправить, нужна помощь.
Цитата: 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 от 14.12.2014, 16:08
... Задача гораздо сложнее, если ничего не получится буду вновь консультироваться. ;)
Ну, к сложностям нам не привыкать. Обращайтесь. Удачи.