Excel VBA: Копирование ячеек на другой лист

[Rus23]

Добрый день.
Помогите, пожалуйста, доработать макрос.
В файл добавляются строки с номерами магазина и другой информацией.
Автоматически создаются новые листы в книге по № магазинов и вставляется в эти листы из листа "шаблон" необходимый формат.
Как доработать макрос так, что бы при создании нового листа по № магазина так же копировалась информация (столбец 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")

[Rus23]

Макрос тогда копирует в каждый лист все строки (т.е. все магазины). А необходимо копировать только одну строку в каждый соответствующий лист.
Т.е. если №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(нужная строка)

[Rus23]

Наверное я не совсем понятно объясняю.
В файл каждый раз заносятся разные магазины. Заранее невозможно предугадать какие номера будут.
Поэтому необходимо копировать и вставлять строку во вновь автоматически создаваемый лист.
Допустим, 2 магазина. По нажатию на кнопку макрос создает два листа с номерами этих магазинов, и должен копировать соответствующие строки в эти листы.
Я знаю как копировать и вставлять и тд. Но конкретно реализовать копирование ячейки в строке определенных магазинов в новый лист с наименованием магазина не получается.

[Администратор]

Нужно так задавать вопросы на форумах.
Нужно создавать файл-пример и по нему задавать вопрос.
Из всего вашего макроса нужно вычленять фрагмент макроса, по которому вопрос, и выкладывать этот макрос на форуме. Вы выложили фрагмент вашего макроса, но его я не могу применить. Вам нужно создать из своего большого макроса маленький, но что бы он работал, чтобы я мог его тестировать.

Весь ваш код я не буду смотреть.

[Rus23]

Сделала как Вы сказали. По нажатию на кнопку "создание листов" создаются три листа: 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

[свернуть]

[Rus23]

Спасибо. Теперь все получилось.

[Rus23]

Доброго времени суток.
Не подскажете по этому макросу еще кое-что, пожалуйста.
Макрос, который обсуждался выше, создает новые листы с наименованием магазинов.
Но проблема в том, что иногда магазины идут через дробь /, а наименование листа не может содержать этот символ.
Как сделать так, что бы макрос брал наименование магазина, создавал лист с этим наименованием, но когда вдруг встречается этот символ, то менял его, скажем, на символ нижнего подчеркивания?

[Администратор]

' Можно не проверять, есть дробь или нет, а просто всегда делать замену. Если дроби нет, то ничего не изменится, если дробь есть, то она будет заменена.
            ' Переименование листа.
            sh.Name = Replace(cel.text, "/", "_")

[Rus23]

Спасибо.