Добрый день.
Помогите, пожалуйста, доработать макрос.
В файл добавляются строки с номерами магазина и другой информацией.
Автоматически создаются новые листы в книге по № магазинов и вставляется в эти листы из листа "шаблон" необходимый формат.
Как доработать макрос так, что бы при создании нового листа по № магазина так же копировалась информация (столбец C в F, столбец D в E) об этом магазине на этот лист?
For Each iCell In Sheets("СТ").[B3:B100]
If iCell.Text = "" Then GoTo Sled
Set sh = Sheets(iCell.Text)
If Err Then
Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = iCell.Text
Else
Err.Clear
End If
Sled:
Next
sh - это лист, из которого нужно скопировать данные?
Просто берёте и копируете:
sh.Columns("C").Copy Activesheet.Columns("F")
Макрос тогда копирует в каждый лист все строки (т.е. все магазины). А необходимо копировать только одну строку в каждый соответствующий лист.
Т.е. если №2, то создается лист с названием 2 и туда автоматически должно копироваться значение из строки, где №2.
For Each iCell In Sheets("СТ").[B3:B100]
If iCell.Text = "" Then GoTo Sled
Set sh = Sheets(iCell.Text)
If Err Then
Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = iCell.Text
Sheets("СТ").Columns("C").Copy ActiveSheet.Columns("F")
Else
Err.Clear
End If
Sled:
Next
В sh, в столбце с названиями магазинов нужно найти нужную строку.
Для этого можно использовать разные способы. Например, можно использовать эксель-функцию ПОИСКПОЗ:
Схематичный код между "If Err Then" и "Else":
Dim r As Long
' Поиск нужной строки с помощью эксель-функции ПОИСКПОЗ.
' Если не знаете эту функцию, то посмотрите справку.
r = WorksheetFunction.Match("искомый магазин", sh.Columns("A"), 0)
' Копирование строки.
sh.Rows(r).Copy ActiveSheet.Rows(нужная строка)
Наверное я не совсем понятно объясняю.
В файл каждый раз заносятся разные магазины. Заранее невозможно предугадать какие номера будут.
Поэтому необходимо копировать и вставлять строку во вновь автоматически создаваемый лист.
Допустим, 2 магазина. По нажатию на кнопку макрос создает два листа с номерами этих магазинов, и должен копировать соответствующие строки в эти листы.
Я знаю как копировать и вставлять и тд. Но конкретно реализовать копирование ячейки в строке определенных магазинов в новый лист с наименованием магазина не получается.
Нужно так задавать вопросы на форумах.
Нужно создавать файл-пример и по нему задавать вопрос.
Из всего вашего макроса нужно вычленять фрагмент макроса, по которому вопрос, и выкладывать этот макрос на форуме. Вы выложили фрагмент вашего макроса, но его я не могу применить. Вам нужно создать из своего большого макроса маленький, но что бы он работал, чтобы я мог его тестировать.
Весь ваш код я не буду смотреть.
Сделала как Вы сказали. По нажатию на кнопку "создание листов" создаются три листа: 56, 78, 34.
Пытаюсь реализовать макрос, что бы копировать столбцы C и D. Во вложении 2 файла. Первый с макросом (Пример).
Второй как должно быть (Пример2).
[вложение удалено администратором]
Вообще, это задание для использования в жизни или это учебное задание для изучения программирования?
С обработкой ошибок нестыковка. Я сразу не заметил.
Эти действия в вашем коде делаются, если происходит ошибка:
Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cel.Text
Очищать ошибку нужно здесь же, а не после Else. В вашем случае после возникновения первой ошибки далее всегда ошибка.
Правильно так:
If Err Then
Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cel.Text
Err.Clear
End If
Код
Sub Листы()
Dim sh As Worksheet, cel As Range
Dim lr As Long
'12. создание листов
On Error Resume Next
For Each cel In Sheets("СТ").[B3:B100]
' Если ячейка пустая, то переходим на следующую строку.
If cel.Text = "" Then GoTo Sled
' Присваивание листу имени "sh".
Set sh = Sheets(cel.Text)
' Если нет листа.
If Err Then
' Создание листа.
Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
' Присвоение листу имени "sh".
Set sh = ActiveSheet
' Переименование листа.
sh.Name = cel.Text
' Сброс ошибки, чтобы поймать ошибку в следующий раз.
Err.Clear
End If
' Копирование данных из одного листа в другой.
' Определение, в какую строку нужно вставить данные на листе-результате.
' При использовании "End", если на листе есть скрытые строки,
' то может быть неправильный результат.
lr = sh.Cells(sh.Rows.Count, "F").End(xlUp).Row + 1
' Копирование данных.
sh.Cells(lr, "F").Value = cel.EntireRow.Columns("A").Value
sh.Cells(lr, "G").Resize(, 2).Value = cel.EntireRow.Columns("C:D").Value
Sled:
Next cel
' Отключение перехватчика ошибок, чтобы поймать непредвиденные ошибки.
On Error GoTo 0
End Sub
Спасибо. Теперь все получилось.
Доброго времени суток.
Не подскажете по этому макросу еще кое-что, пожалуйста.
Макрос, который обсуждался выше, создает новые листы с наименованием магазинов.
Но проблема в том, что иногда магазины идут через дробь /, а наименование листа не может содержать этот символ.
Как сделать так, что бы макрос брал наименование магазина, создавал лист с этим наименованием, но когда вдруг встречается этот символ, то менял его, скажем, на символ нижнего подчеркивания?
' Можно не проверять, есть дробь или нет, а просто всегда делать замену. Если дроби нет, то ничего не изменится, если дробь есть, то она будет заменена.
' Переименование листа.
sh.Name = Replace(cel.text, "/", "_")
Спасибо.