Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование нескольких листов Excel с присваиванием имен и изменения содержания. VBA
 
#1
19.04.2017 01:01:33
Доброго времени суток. Давно не занимался VBA и многое уже забыл, нужна помощь.
Есть два листа в книге, первый выполняет роль шаблона, второй имеет таблицу данных (столбцы А и В)
Нужно сделать несколько действий в одном макросе:

1) Сделать 10 копий листа шаблон.
2) Присвоить каждому листу имя из диапазона А1:А10 с  листа Данные.
3) В каждом новом листе изменить (частично) ячейку А26, то есть добавить содержимое из столбца В1:В10

Суть в чем.
1) Сделать макрос на копирование 10 листов я сделал.
Код
Sub Copy_10Sheets()
    x = InputBox("1")
    For numtimes = 1 To x
    Application.DisplayAlerts = False
    Sheets("Шаблон").Copy After:=Sheets(2)
    Next
End Sub

2) Сделать копию листа с именем, смог додуматься только до этого, и то благодаря макрорекодеру
Код
Sub Макрос2()
 Dim shNewSheet As Excel.Worksheet
 Set shNewSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
   shNewSheet.Name = Worksheets(1).Range("A7").Text
End Sub

То есть задать в первом макросе имя для нового листа я не смог, а лишь создал новый лист с именем из столбца
3) Изменить частично ячейку
Код
Sub macro_copy_cell()
    Sheets("Данные").Select
    Range("B7").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "200"
    Sheets("Шаблон").Select
    Range("A26").Select
    ActiveCell.FormulaR1C1 = "200 SMS"
End Sub

Но проблема в том, в макрорекодере я уже указал что копирую, то есть конкретно "200" а не содержимое ячейки.

Товарищи, понимаю что мои вопросы могут показаться крайне глупыми, но на ночь глядя, ничего умнее придумать я тут не могу. Помогите пожалуйста.
Изменено: RetroBaton - 19.04.2017 21:17:32
 
 
 
#2
19.04.2017 02:21:04
Код
Sub Make10SheetCopy()
  Dim i&
  For i = 1 To 10
    Worksheets(1).Copy after:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = Worksheets(2).Cells(i, 1)
    Cells(26, 1) = Worksheets(2).Cells(i, 2) & Cells(26, 1)
  Next
End Sub
Изменено: Ігор Гончаренко - 19.04.2017 02:21:21
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
19.04.2017 12:15:33
Цитата
RetroBaton написал:
но на ночь глядя...
Попробуйте утром ))
RetroBaton,  код следует оформлять соответствующим тегом - ищите такую кнопку и исправьте своё сообщение.
 
 
 
#4
19.04.2017 20:41:35
Ігор Гончаренко
Не подскажите детально по каждой строке?

Два и три это запуск цикла от 1 до 10
Четыре это копия листа (1), в моем случае это лист два
Пять это присвоить имя листов (не совсем понятная связь с функцией .count) задает имя листов из листа 2 (в моем случае лист 1) равной i первого стобца (Столбца А) проблема тут в том что у меня массив начинается с ячейки А7, ну и получается ошибка.
Шесть - по сути понятно вроде бы что нужно сделать, но он ничего не делает и не меняет ячейки.

Так и не могу решить эту проблему(  
 
 
 
#5
19.04.2017 21:18:58
RetroBaton, Вы бы лучше показали свой файл-пример с двумя исходными листами, а третий - результат, который Вы хотели бы получить.  
 
 
 
#6
19.04.2017 23:21:01
Исходные данные имею таблицу массив. Надо сделать макрос, который будет копировать лист Шаблон 10 раз, и каждый лист будет именоваться из столбца А, а в ячейку А10 (листа Шаблон) будет заменяться выражение ХХХ на число из столбца В.

Сделать копию 10 листов я понял, а вот с именами и заменой в ячейке я повис.
 
 
 
#7
19.04.2017 23:35:24
Код
Sub CopySheet()
Dim i As Long
    Application.ScreenUpdating = False
    For i = 1 To 10
        Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Sheets("Данные").Cells(i + 1, 1)
            .Range("A10") = Sheets("Данные").Cells(i + 1, 2)
        End With
    Next
    Application.ScreenUpdating = True
End Sub
 
 
 
#8
21.04.2017 00:13:43
Юрий М
Работает, только я подредактировал и изменил строку
Код
Application.ScreenUpdating = False
на
Код
Application.DisplayAlerts = False

Юрий, такой еще вопрос, в ячейке А10 листа Шаблон, Макрос именно заменяет ячейку, а можно сделать так, чтобы он частично ее редактировал?
 
 
 
#9
21.04.2017 00:25:00
А зачем DisplayAlerts? Я специально отключал обновление экрана, чтобы избежать мелькания.
По вопросу - макрос может, если ему объяснить, что от него требуется )
 
 
 
#10
21.04.2017 02:03:51
Юрий М
Ну я отключил отображение сообщений, тк ошибка без конца вылетала.
А не подскажите как сделать такой макрос, чтобы понимать его работу
 
 
 
#11
21.04.2017 10:58:26
У меня никакой ошибки не возникало. И что за ошибка у Вас? А вот Ваш вопрос не понял.  
 
 
 
#12
21.04.2017 12:33:55
Юрий М
Ну полный шаблон он большой и содержит много именных ячеек, и почему-то вылетает сообщение что имя занято, но это не важно.

Суть вопроса про макрос, если глянуть мой шаблон выше, что на втором листе в ячейке А10 стоит фраза (ХХХ раз) можно ли сделать макрос чтобы он частично редактировал ячейку, то есть заменил значение ХХХ но оставил слово РАЗ.
 
 
 
#13
21.04.2017 13:34:07
Цитата
RetroBaton написал:
можно ли сделать макрос чтобы он частично редактировал ячейку, то есть заменил значение ХХХ но оставил слово РАЗ.
Можно.
 
 
 
#14
22.04.2017 12:57:23
Юрий М
эм) а не подскажите как? Частичная замена ячейки - это кол-во знаков, которое нужно пропустить в ней.
Код
.Range("A10") = Sheets("Данные").Cells(4 + i, 2)
Разве так?
 
 
 
#15
22.04.2017 23:12:49
Никогда не формулируйте вопросы аналогичным образом (#12), если не хотите получать ответы в стиле #13 ))
Вариант:
Код
Sub CopySheet()
Dim i As Long, Stroka As String
    Stroka = " " & Split(Sheets("Шаблон").Range("A10"))(1)
    Application.ScreenUpdating = False
    For i = 1 To 10
        Sheets("Шаблон").Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Sheets("Данные").Cells(i + 1, 1)
            .Range("A10") = Sheets("Данные").Cells(i + 1, 2) & Stroka
        End With
    Next
    Application.ScreenUpdating = True
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх