Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос: скопировать строку и вставить в первой свободной строке ниже., Необходимо помощь написать макрос который бы позволял копировать выбранную строку и вставить ее в пустую строку ниже.
 
#1
07.07.2017 10:15:53
Здравствуйте, уважаемые форумчане! Помогите пожалуйста.

Имеется таблица Excel с данными (заявками клиента), где каждая строка это отдельная заявка (название клиента, адрес, телефон, и т.д.).
На данный момент при оформлении новой заявки от уже имеющегося клиента (есть в таблице) я произвожу такие действия:
- с помощью "CTRL+F" делаю поиск по названию клиента или адресу, копирую строку с предыдущей заявкой этого клиента.
- нажатием "CTRL+стрелка вниз" перехожу к последней записи в таблице.
- еще раз нажимаю "стрелку вниз" и вставляю скопированную строку.
- исправляю необходимые данные в заявке.

Хотелось бы автоматизировать эти монотонные тыканья по клавиатуре, но я к сожалению очень далек от макросов и VBA.
Думаю для разбирающихся не составит труда составить код.
Изменено: Medium - 07.07.2017 10:16:02
 
 
 
#2
07.07.2017 10:40:37
Здравствуйте.
Нужен файл-пример, достаточно 20-50 строк (не надо весь рабочий файл). Покажите, что есть и что хотите получить на выходе.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#3
07.07.2017 10:50:14
Цитата
Medium написал:
- исправляю необходимые данные в заявке.
макрос, который скопирует строку, может очистить и эти ячейки, чтобы оператор не пропустил их случайно и не оставил там старые данные
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
07.07.2017 11:10:03
Владимир, в приложении файл с несколькими записями.

Я хочу добавить в файле кнопку, к которой будет привязан макрос, который выделенную мной строку скопирует в первую свободную строку снизу. Например, в моем файле получится, что скопированную строку мы вставим в сроку №8 (она первая пустая).
 
 
 
#5
07.07.2017 11:21:53
Цитата
Владимир написал:
покажите, что есть и что хотите получить на выходе.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#6
07.07.2017 11:54:32
Код
Public Sub www()
    Cells(ActiveCell.Row, 1).Resize(, 9).Copy Cells(Rows.Count, 1).End(xlUp)(2)
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#7
07.07.2017 12:27:23
Я сделал следующее своими кривыми руками:
Код
Sub Скопировать_вставить()

' Скопировать_вставить макрос


    With ActiveCell
    Range(Cells(.Row, 1), Cells(.Row, 10)).Copy
End With
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell(2).Activate
    ActiveSheet.Paste

End Sub

В принципе работает.
Ошибка только в случае если я выделяю последнюю занятую ячейку, так как в этом случае ActiveCell(2).Activate не возможен.
 
 
 
#8
07.07.2017 12:38:06
kuklp, спасибо! У вас получилось гораздо компактнее и без ошибки что есть в моем макросе!
Изменено: Medium - 07.07.2017 12:38:20
 
 
 
#9
07.07.2017 12:56:32
В этом случае вообще кнопка не нужна. Только макрос нужно поместить в модуль листа.
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lstr&
If Target.Cells.Count <> 10 Then Exit Sub  'если выделено НЕ 10 ячеeк, то выходим
    lstr = Cells(Rows.Count, 1).End(xlUp).Row 'получаем номер последней заполненной строки
    If Not Intersect(Target, Range([A4], Cells(lstr, 10))) Is Nothing Then
        Application.EnableEvents = False
            Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Copy Cells(Rows.Count, 1).End(xlUp)(2)
        Application.EnableEvents = True
    End If
End Sub
Изменено: Владимир - 07.07.2017 13:40:16
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#10
23.02.2023 13:37:35
Цитата
написал:
Public Sub www()    Cells(ActiveCell.Row, 1).Resize(, 9).Copy Cells(Rows.Count, 1).End(xlUp)(2)End Sub
Спасибо, подходит под мою задачу)
Подскажите, пожалуйста, есть ли вариант макроса для копирования в конец таблицы НЕСКОЛЬКО выделенных (последовательно) строк?
 
 
 
#11
15.06.2023 23:04:46
Добрый день

У меня похожая тема. Копировать данные из столбца ячеек Excel, записать их в первую свободную строчку (transpose) в другом файле Excel
Предложенный вариант кода дает сбой на следующей строке.

Не подскажете в чем моя ошибка?
Изменено: Const20 - 15.06.2023 23:05:58 (добавил файл)
 
 
 
#12
15.06.2023 23:45:48
Const20
1. Раз у вас MacBook, то забудьте про любые русские буквы в коде любых макросов. Ваш МакБук все русские буквы коверкает внутри макросов. Да, даже названия макросов не называйте русскими буквами.
2. в вашем файле 2 макроса - нам какой из них смотреть?

Если просто смотреть на ваш файл и с вашим скудным описанием задачи, то вам подойдёт вот такой код (см. ниже), но я не думаю, что это то, что вы хотите получить в конечном итоге

Код
Sub Test()
    Dim ShtFactura As Worksheet
    Dim Sht2 As Worksheet
    
    Set ShtFactura = Worksheets("factura")
    Set Sht2 = Worksheets("Лист2")
    
    Sht2.Range("B1").Value = ShtFactura.Range("E4").Value
    Sht2.Range("B2").Value = ShtFactura.Range("E5").Value
    Sht2.Range("B3").Value = ShtFactura.Range("E6").Value
    Sht2.Range("B4").Value = ShtFactura.Range("E7").Value
    Sht2.Range("B5").Value = ShtFactura.Range("E8").Value
    Sht2.Range("B6").Value = ShtFactura.Range("E9").Value
    Sht2.Range("B7").Value = ShtFactura.Range("E10").Value
    Sht2.Range("B8").Value = ShtFactura.Range("B12").Value
    Sht2.Range("B9").Value = ShtFactura.Range("C12").Value
    Sht2.Range("B10").Value = ShtFactura.Range("E12").Value
    Sht2.Range("B11").Value = ShtFactura.Range("F14").Value
End Sub
Изменено: New - 15.06.2023 23:49:02
 
 
 
#13
15.06.2023 23:49:11
смотреть макрос CSV
 
 
 
#14
15.06.2023 23:52:24
И мне же надо найти первую пустую строку в файле, куда я копирую данные
 
 
 
#15
15.06.2023 23:54:40
То есть файлов, откуда я буду брать данные будет много, в каждом из них будет этот макрос, который по запросу берет данные из этого конкретного файла и записывает в первую незаполненную строку в файле 2023_sendpulse.xlsx
 
 
 
#16
16.06.2023 00:02:16
Если честно, я не очень понимаю, поэтому дам общий совет, как найти последнюю заполненную ячейку в столбце В, вот примерный код

Код
'копируете ячейки
'....
'определяем номер последней строки в столбце В и к ней прибавляем +1
LastRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
'вставляете данные в нужную ячейку в столбце В (2 это второй столбец, т.е. В)
Cells(LastRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Изменено: New - 16.06.2023 00:04:16
 
 
 
#17
16.06.2023 00:09:02
Спасибо огромное за столь подробный ответ! Все работает именно так как я хотел!
 
 
 
Страницы: 1
Читают тему
Наверх