Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки ниже выделенной (Макросы/Sub)
Копирование строки ниже выделенной
Maxon_R Дата: Понедельник, 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
 
Ответить
СообщениеДрузья, привет!
Уровень знаний VBA почти на нуле. Несколько дней пытаюсь сделать макрос, но безрезультатно. Прошу вашей помощи!

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

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

Возможно?

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

Автор - Maxon_R
Дата добавления - 03.07.2017 в 19:14
buchlotnik Дата: Понедельник, 03.07.2017, 19:41 | Сообщение № 2
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Цитата
пытаюсь сделать макрос
и где эти попытки? почему файл .xlsx?
 
Ответить
Сообщение
Цитата
пытаюсь сделать макрос
и где эти попытки? почему файл .xlsx?

Автор - buchlotnik
Дата добавления - 03.07.2017 в 19:41
InExSu Дата: Вторник, 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
 
Ответить
Сообщение[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]

Автор - InExSu
Дата добавления - 04.07.2017 в 09:18
Maxon_R Дата: Вторник, 04.07.2017, 10:50 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
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
 
Ответить
Сообщение
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:50
Maxon_R Дата: Вторник, 04.07.2017, 10:54 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
и где эти попытки? почему файл .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
 
Ответить
Сообщение
и где эти попытки? почему файл .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 в 10:54
Manyasha Дата: Вторник, 04.07.2017, 11:05 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

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


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеMaxon_R, оформите код тегами (кнопка #)

Автор - Manyasha
Дата добавления - 04.07.2017 в 11:05
InExSu Дата: Вторник, 04.07.2017, 12:22 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
ошибка на 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
 
Ответить
Сообщение
ошибка на 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]

Автор - InExSu
Дата добавления - 04.07.2017 в 12:22
Maxon_R Дата: Вторник, 04.07.2017, 12:36 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

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

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

[vba]
Код
Selection.Insert Shift:=xlDown
[/vba]

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



Сообщение отредактировал Maxon_R - Вторник, 04.07.2017, 12:37
 
Ответить
Сообщение
Selection.EntireRow.Insert 'или запишите макрорекордером как у вас, в 2016, вставляется строка

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

[vba]
Код
Selection.Insert Shift:=xlDown
[/vba]

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


Автор - Maxon_R
Дата добавления - 04.07.2017 в 12:36
InExSu Дата: Вторник, 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
 
Ответить
Сообщениепочикано

Автор - InExSu
Дата добавления - 04.07.2017 в 15:50
sboy Дата: Вторник, 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
 
Ответить
СообщениеДобрый день.
Проверяйте.
[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.]Ну и защиту от "случайно" неправильной выбранной строки бы надо сделать

Автор - sboy
Дата добавления - 04.07.2017 в 16:56
InExSu Дата: Вторник, 04.07.2017, 19:04 | Сообщение № 11
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365

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

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


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
Сообщение
Хороший код,. Не заню зачем, но топикстартер хочет
со вставкой ниже

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

Автор - InExSu
Дата добавления - 04.07.2017 в 19:04
KuklP Дата: Вторник, 04.07.2017, 19:54 | Сообщение № 12
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Ну и напишите:
[vba]
Код
.Offset(1).Insert
[/vba]и будет Вам счастье.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНу и напишите:
[vba]
Код
.Offset(1).Insert
[/vba]и будет Вам счастье.

Автор - KuklP
Дата добавления - 04.07.2017 в 19:54
Pelena Дата: Вторник, 04.07.2017, 19:58 | Сообщение № 13
Группа: Админы
Ранг: Местный житель
Сообщений: 19162
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
код вставляет ВЫШЕ

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


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
код вставляет ВЫШЕ

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

Автор - Pelena
Дата добавления - 04.07.2017 в 19:58
RAN Дата: Вторник, 04.07.2017, 20:39 | Сообщение № 14
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

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

Цитата
И правую палочку делают так-же!
:D
А если серьезно, для 1 строки разницы нет, или почти нет, для 2 появится (или не появится).


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Какая разница?

Цитата
И правую палочку делают так-же!
:D
А если серьезно, для 1 строки разницы нет, или почти нет, для 2 появится (или не появится).

Автор - RAN
Дата добавления - 04.07.2017 в 20:39
Maxon_R Дата: Среда, 05.07.2017, 09:54 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
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
 
Ответить
Сообщение
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:54
AndreTM Дата: Среда, 05.07.2017, 10:14 | Сообщение № 16
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Всё равно вылезает эта ошибка...(((
А у вас там объединенных ячеек по строке, где пытаетесь делать вставку - не наблюдается?

Вообще, если у вас ошибки в ВАШЕМ коде - то прикладывайте ВАШИ файлы.
Потому что копировал лист из другой книги.
вообще ни о чём - при чём здесь какой-то лист из какой-то книги?..


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
Сообщение
Всё равно вылезает эта ошибка...(((
А у вас там объединенных ячеек по строке, где пытаетесь делать вставку - не наблюдается?

Вообще, если у вас ошибки в ВАШЕМ коде - то прикладывайте ВАШИ файлы.
Потому что копировал лист из другой книги.
вообще ни о чём - при чём здесь какой-то лист из какой-то книги?..

Автор - AndreTM
Дата добавления - 05.07.2017 в 10:14
Maxon_R Дата: Среда, 05.07.2017, 10:16 | Сообщение № 17
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всё заработало! Большое спасибо!
 
Ответить
СообщениеВсё заработало! Большое спасибо!

Автор - Maxon_R
Дата добавления - 05.07.2017 в 10:16
sboy Дата: Среда, 05.07.2017, 10:39 | Сообщение № 18
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Maxon_R, сейчас еще раз посмотрел файл и возник вопрос, а точно Вам нужно
столбцы ... с L по конец должны быть пустые
???
ведь там у Вас формула


Яндекс: 410016850021169
 
Ответить
СообщениеMaxon_R, сейчас еще раз посмотрел файл и возник вопрос, а точно Вам нужно
столбцы ... с L по конец должны быть пустые
???
ведь там у Вас формула

Автор - sboy
Дата добавления - 05.07.2017 в 10:39
Nordheim Дата: Пятница, 07.07.2017, 12:32 | Сообщение № 19
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Еше вариантик :D
[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]


Все гениальное просто и все простое гениально.
 
Ответить
СообщениеЕше вариантик :D
[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]

Автор - Nordheim
Дата добавления - 07.07.2017 в 12:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки ниже выделенной (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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