Копирование строки ниже выделенной - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Копирование строки ниже выделенной - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Копирование строки ниже выделенной (Макросы/Sub)

Копирование строки ниже выделенной

Дата: Понедельник, 03.07.2017, 19:14 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Друзья, привет!
Уровень знаний VBA почти на нуле. Несколько дней пытаюсь сделать макрос, но безрезультатно. Прошу вашей помощи!

Суть:
При нажатии на кнопку должно производиться копирование активной (выделенной) строки со вставкой ниже, чтобы строки можно было вставлять между уже заполненными строками.
При этом важно, чтобы копировалось всё - значения, формулы, форматирование, условное форматирование
Но столбцы с B:G и с L по конец должны быть пустые.

Основная задача файла - создавать себе список задач на день.

Возможно?

Заранее благодарю!

К сообщению приложен файл: 4532522.xlsx (19.8 Kb)

Сообщение отредактировал Maxon_R - Понедельник, 03.07.2017, 19:16

Ответить

Дата: Понедельник, 03.07.2017, 19:41 | Сообщение № 2

Группа: Заблокированные

Ранг: Участник клуба

Сообщений: 3442

Репутация: 929 ±

Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG

Цитата

пытаюсь сделать макрос

и где эти попытки? почему файл .xlsx?

Ответить

Дата: Вторник, 04.07.2017, 09:18 | Сообщение № 3

Группа: Друзья

Ранг: Ветеран

Сообщений: 648

Репутация: 96 ±

Замечаний: 0% ±

Excel 2010, 365

[vba]

Код

Sub КопированиеCтрокиНижеВыделенной()
    Dim Столбец01 As Long, Столбец02 As Long, Строка As Long
    Столбец01 = 7: Столбец02 = 12

    ActiveCell.EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.EntireRow.Insert
    ActiveSheet.Paste
    Строка = ActiveCell.Row
    Range(Cells(Строка, 1), Cells(Строка, Столбец01)).Select
    Selection.Clear
    Range(Cells(Строка, Столбец01), Cells(Строка, 190)).Select
    Selection.Clear
End Sub

[/vba]

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Ответить

Дата: Вторник, 04.07.2017, 10:50 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата InExSu, 04.07.2017 в 09:18, в сообщении № 3 ()

Sub КопированиеCтрокиНижеВыделенной()
Dim Столбец01 As Long, Столбец02 As Long, Строка As Long
Столбец01 = 7: Столбец02 = 12

ActiveCell.EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.EntireRow.Insert
ActiveSheet.Paste
Строка = ActiveCell.Row
Range(Cells(Строка, 1), Cells(Строка, Столбец01)).Select
Selection.Clear
Range(Cells(Строка, Столбец01), Cells(Строка, 190)).Select
Selection.Clear
End Sub

Спасибо! Строку добавляет, но вываливается ошибка на ActiveCell.EntireRow.Insert

Сообщение отредактировал Maxon_R - Вторник, 04.07.2017, 10:57

Ответить

Дата: Вторник, 04.07.2017, 10:54 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата buchlotnik, 03.07.2017 в 19:41, в сообщении № 2 ()

и где эти попытки? почему файл .xlsx?

Потому что копировал лист из другой книги.

У меня ранее была версия, которая добавляла ячейку. При этому всё работало, т.к. было форматирование как таблица.
Сейчас хочется немного расширить функционал и уйти от форматирования таблицей.
Сейчас я код уже испортил своими попытками и выглядит он примерно так.
[vba]

Код

Sub Макрос4()
Dim i As String, j As String
i = ActiveCell.Address
ActiveCell.Select
ActiveRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub

[/vba]

Сообщение отредактировал Maxon_R - Вторник, 04.07.2017, 11:05

Ответить

Дата: Вторник, 04.07.2017, 11:05 | Сообщение № 6

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 901 ±

Замечаний: 0% ±

Excel 2010, 2016

Maxon_R, оформите код тегами (кнопка #)

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Вторник, 04.07.2017, 12:22 | Сообщение № 7

Группа: Друзья

Ранг: Ветеран

Сообщений: 648

Репутация: 96 ±

Замечаний: 0% ±

Excel 2010, 365

Цитата Maxon_R, 04.07.2017 в 10:50, в сообщении № 4 ()

ошибка на ActiveCell.EntireRow.Insert

на Excel 2010 этой ошибки не появляется.

Улучшаю:
[vba]

Код

Sub КопированиеCтрокиНижеВыделенной()
    Dim Столбец01 As Long, Столбец02 As Long, Строка As Long
    Столбец01 = 7: Столбец02 = 12

    ActiveCell.EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.EntireRow.Insert 'или запишите макрорекордером как у вас, в 2016, вставляется строка
    ActiveSheet.Paste
    Строка = ActiveCell.Row
    Range(Cells(Строка, 1), Cells(Строка, Столбец01)).Select
    Selection.ClearContents
    Range(Cells(Строка, Столбец01), Cells(Строка, 190)).Select
    Selection.ClearContents
End Sub

[/vba]

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Ответить

Дата: Вторник, 04.07.2017, 12:36 | Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата InExSu, 04.07.2017 в 12:22, в сообщении № 7 ()

Selection.EntireRow.Insert 'или запишите макрорекордером как у вас, в 2016, вставляется строка

в 16 добавление строки написалось так:

[vba]

Код

Selection.Insert Shift:=xlDown

[/vba]

Попробовал заменить строку в коде - появилась другая ошибка.

Сообщение отредактировал Maxon_R - Вторник, 04.07.2017, 12:37

Ответить

Дата: Вторник, 04.07.2017, 15:50 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 648

Репутация: 96 ±

Замечаний: 0% ±

Excel 2010, 365

почикано

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Сообщение отредактировал InExSu - Вторник, 04.07.2017, 15:51

Ответить

Дата: Вторник, 04.07.2017, 16:56 | Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Добрый день.
Проверяйте.
[vba]

Код

Sub дз()
r = ActiveCell.Row
c = Cells(8, Columns.Count).End(xlToLeft).Column
With Rows(r)
.Copy
.Insert
End With
Range(Cells(r + 1, 2), Cells(r + 1, 7)).ClearContents
Range(Cells(r + 1, 12), Cells(r + 1, c)).ClearContents
End Sub

[/vba]
[p.s.]Ну и защиту от "случайно" неправильной выбранной строки бы надо сделать

К сообщению приложен файл: 4532522.xlsm (24.8 Kb)

Яндекс: 410016850021169

Ответить

Дата: Вторник, 04.07.2017, 19:04 | Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 648

Репутация: 96 ±

Замечаний: 0% ±

Excel 2010, 365

Цитата sboy, 04.07.2017 в 16:56, в сообщении № 10 ()

.Insert

Хороший код,. Не заню зачем, но топикстартер хочет

Цитата Maxon_R, 03.07.2017 в 19:14, в сообщении № 1 ()

со вставкой ниже

А Ваш код вставляет ВЫШЕ активной ячейки.

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Ответить

Дата: Вторник, 04.07.2017, 19:54 | Сообщение № 12

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Ну и напишите:
[vba]

Код

.Offset(1).Insert

[/vba]и будет Вам счастье.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Дата: Вторник, 04.07.2017, 19:58 | Сообщение № 13

Группа: Админы

Ранг: Местный житель

Сообщений: 19401

Репутация: 4549 ±

Замечаний: ±

Excel 365 & Mac Excel

Цитата InExSu, 04.07.2017 в 19:04, в сообщении № 11 ()

код вставляет ВЫШЕ

Какая разница? Ведь строка копируется

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Дата: Вторник, 04.07.2017, 20:39 | Сообщение № 14

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Цитата Pelena, 04.07.2017 в 19:58, в сообщении № 13 ()

Какая разница?

Цитата

И правую палочку делают так-же!

А если серьезно, для 1 строки разницы нет, или почти нет, для 2 появится (или не появится).

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Среда, 05.07.2017, 09:54 | Сообщение № 15

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата sboy, 04.07.2017 в 16:56, в сообщении № 10 ()

Sub дз()
r = ActiveCell.Row
c = Cells(8, Columns.Count).End(xlToLeft).Column
With Rows®
.Copy
.Insert
End With
Range(Cells(r + 1, 2), Cells(r + 1, 7)).ClearContents
Range(Cells(r + 1, 12), Cells(r + 1, c)).ClearContents
End Sub

Всё равно вылезает эта ошибка...(((

Сообщение отредактировал Maxon_R - Среда, 05.07.2017, 09:55

Ответить

Дата: Среда, 05.07.2017, 10:14 | Сообщение № 16

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация: 501 ±

Замечаний: 0% ±

2003 & 2010

Цитата Maxon_R, 05.07.2017 в 09:54, в сообщении № 15 ()

Всё равно вылезает эта ошибка...(((

А у вас там объединенных ячеек по строке, где пытаетесь делать вставку - не наблюдается?

Вообще, если у вас ошибки в ВАШЕМ коде - то прикладывайте ВАШИ файлы.

Цитата Maxon_R, 04.07.2017 в 10:54, в сообщении № 5 ()

Потому что копировал лист из другой книги.

вообще ни о чём - при чём здесь какой-то лист из какой-то книги?..

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Ответить

Дата: Среда, 05.07.2017, 10:16 | Сообщение № 17

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Всё заработало! Большое спасибо!

Ответить

Дата: Среда, 05.07.2017, 10:39 | Сообщение № 18

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Maxon_R, сейчас еще раз посмотрел файл и возник вопрос, а точно Вам нужно

Цитата Maxon_R, 03.07.2017 в 19:14, в сообщении № 1 ()

столбцы ... с L по конец должны быть пустые

???
ведь там у Вас формула

Яндекс: 410016850021169

Ответить

Дата: Пятница, 07.07.2017, 12:32 | Сообщение № 19

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Еше вариантик

[vba]

Код

Sub test()
Dim i&
i = ActiveCell.Row
Rows(i + 1).Insert
Rows(i + 1).FillDown
Range("d" & i + 1 & ":g" & i + 1).ClearContents
Range("l" & i + 1).End(xlToRight).ClearContents
End Sub

[/vba]

Все гениальное просто и все простое гениально.

Ответить

Копирование строки ниже выделенной (Макросы/Sub)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!