Такой вопрос: имеется файл с 2 листами, данные и шаблон (скрытый). Как составить макрос так, чтобы по клику на кнопку (в первом листе) создавалась копия шаблона (не скрытая), в которую нужно скопировать некоторые столбцы из первого листа.
Например (см. в аттаче) нужно копировать данные из столбцов col1 и col3 в newcol1 и newcol3 соответственно.
Приветствую.
Такой вопрос: имеется файл с 2 листами, данные и шаблон (скрытый). Как составить макрос так, чтобы по клику на кнопку (в первом листе) создавалась копия шаблона (не скрытая), в которую нужно скопировать некоторые столбцы из первого листа.
Например (см. в аттаче) нужно копировать данные из столбцов col1 и col3 в newcol1 и newcol3 соответственно.xaser
Private Sub CommandButton1_Click() With Sheets("Данные") lr = Cells(.Rows.Count, 6).End(xlUp).Row Set myRng = .Range("F9:H" & lr) End With With Sheets("Шаблон") .Range("E13:G" & lr + 4) = myRng.Value .Cells.Copy Sheets("Данные").[a1] .Range("E13:G" & lr + 4).Clear End With End Sub
[/vba] Если честно, мне самой не нравится то, что я написала! XD Код требует знания левых верхних координат диапазонов на обоих листах. А еще, что называется влоб прописано кол-во столбцов, которые будут скопированы, да и вообще какой-то некрасивый макрос получился, но зато работает. [p.s.]Любая критика в мой адрес со стороны экспертом VBA принимается с удовольствием![/p.s.]
xaser, здравствуйте. Как-то так:[vba]
Код
Private Sub CommandButton1_Click() With Sheets("Данные") lr = Cells(.Rows.Count, 6).End(xlUp).Row Set myRng = .Range("F9:H" & lr) End With With Sheets("Шаблон") .Range("E13:G" & lr + 4) = myRng.Value .Cells.Copy Sheets("Данные").[a1] .Range("E13:G" & lr + 4).Clear End With End Sub
[/vba] Если честно, мне самой не нравится то, что я написала! XD Код требует знания левых верхних координат диапазонов на обоих листах. А еще, что называется влоб прописано кол-во столбцов, которые будут скопированы, да и вообще какой-то некрасивый макрос получился, но зато работает. [p.s.]Любая критика в мой адрес со стороны экспертом VBA принимается с удовольствием![/p.s.]Manyasha
Private Sub CommandButton1_Click() Dim rowsData&, colsData&, rowTempl As Integer, colTempl& With Sheets("Шаблон") rowsData = Selection.Rows.Count colsData = Selection.Columns.Count rowTempl = .Range("шапка").Row + 1 colTempl = .Range("шапка").Column If colsData <> .Range("шапка").Columns.Count Then MsgBox "Диапазон для копирования не согласован с шаблоном!": Exit Sub End If .Range(.Cells(rowTempl, colTempl), _ .Cells(rowTempl + rowsData - 1, colTempl + colsData - 1)) = Selection.Value .Cells.Copy Sheets("Данные").[a1] .Range(.Cells(rowTempl, colTempl), _ .Cells(rowTempl + rowsData - 1, colTempl + colsData - 1)).Clear End With End Sub
[/vba]
Перед запуском макроса нужно выделить диапазон, который необходимо скопировать.
Елена, у Вас не копируется 2-й столбик (G). А так, идея копировать шаблон на новый лист, вместо того, чтобы копировать данные туда-сюда, а потом еще и очищать (как у меня сделано), мне нравится. Можно совместить с моим макросом, тогда совсем будет хорошо.
Вот переделала! Теперь намного лучше:
[vba]
Код
Private Sub CommandButton1_Click() Dim rowsData&, colsData&, rowTempl As Integer, colTempl& With Sheets("Шаблон") rowsData = Selection.Rows.Count colsData = Selection.Columns.Count rowTempl = .Range("шапка").Row + 1 colTempl = .Range("шапка").Column If colsData <> .Range("шапка").Columns.Count Then MsgBox "Диапазон для копирования не согласован с шаблоном!": Exit Sub End If .Range(.Cells(rowTempl, colTempl), _ .Cells(rowTempl + rowsData - 1, colTempl + colsData - 1)) = Selection.Value .Cells.Copy Sheets("Данные").[a1] .Range(.Cells(rowTempl, colTempl), _ .Cells(rowTempl + rowsData - 1, colTempl + colsData - 1)).Clear End With End Sub
[/vba]
Перед запуском макроса нужно выделить диапазон, который необходимо скопировать.
Елена, у Вас не копируется 2-й столбик (G). А так, идея копировать шаблон на новый лист, вместо того, чтобы копировать данные туда-сюда, а потом еще и очищать (как у меня сделано), мне нравится. Можно совместить с моим макросом, тогда совсем будет хорошо.Manyasha
Private Sub CommandButton1_Click() Sheets("Шаблон").Copy Before:=Sheets(1) Sheets(1).Visible = xlSheetVisible Sheets(1).Activate ' по желанию, но не обязательно With Sheets("Данные") lr = .Cells(.Rows.Count, "F").End(xlUp).Row .Range("F9", "F" & lr).Copy Sheets(1).Range("E13") .Range("H9", "H" & lr).Copy Sheets(1).Range("G13") End With End Sub
[/vba]
[p.s.]Точнее, не с самим копированием, а с последующей вставкой.[/p.s.]
Leanna, при наличии скрытых листов с этим [vba]
Код
Sheets("Шаблон").Copy after:=Sheets(Sheets.Count)
[/vba] могут возникнуть проблемы Лучше так [vba]
Код
Private Sub CommandButton1_Click() Sheets("Шаблон").Copy Before:=Sheets(1) Sheets(1).Visible = xlSheetVisible Sheets(1).Activate ' по желанию, но не обязательно With Sheets("Данные") lr = .Cells(.Rows.Count, "F").End(xlUp).Row .Range("F9", "F" & lr).Copy Sheets(1).Range("E13") .Range("H9", "H" & lr).Copy Sheets(1).Range("G13") End With End Sub
[/vba]
[p.s.]Точнее, не с самим копированием, а с последующей вставкой.[/p.s.]RAN
Быть или не быть, вот в чем загвоздка!
Сообщение отредактировал RAN - Суббота, 11.04.2015, 15:56
Leanna, все верно 1й и 3й, хотя не обязательно (т.е суть в том что не весь лист целиком копируется) А под указанием имени я имел ввиду как это в макросе прописать, что бы всегда одинаковым было, например "результат", ну тут сам разберусь уже.
Leanna, все верно 1й и 3й, хотя не обязательно (т.е суть в том что не весь лист целиком копируется) А под указанием имени я имел ввиду как это в макросе прописать, что бы всегда одинаковым было, например "результат", ну тут сам разберусь уже.xaser
Сообщение отредактировал xaser - Суббота, 11.04.2015, 16:05
Я не сдамся Вот поправила свой вариант, копирует все также выделенный фрагмент, только теперь можно копировать и несвязные диапазоны (невнимательно прочитала задание сначала). Нужно только задать диапазоны шапочек (см. ctrl+f3)
Я не сдамся Вот поправила свой вариант, копирует все также выделенный фрагмент, только теперь можно копировать и несвязные диапазоны (невнимательно прочитала задание сначала). Нужно только задать диапазоны шапочек (см. ctrl+f3)Manyasha
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
