Копирование и вставка через буфер обмена двумя макросами

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

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

Копирование и вставка через буфер обмена двумя макросами (Макросы/Sub)

Markovich

Дата: Воскресенье, 21.02.2021, 13:27 | Сообщение № 1

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

Ранг: Участник

Сообщений: 50

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

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

Excel 2019

Доброго времени суток, уважаемые форумчане! Думал, что операция копирования-вставки получится просто как палка-веревка, а получилось как всегда, т.е. не получается без обращения за помощью на любимый форум. Задача такая... есть две таблицы, в одной таблице я выделяю несколько ячеек по строкам (по вертикали) и макросом в буфер обмена копирую требуемый диапазон. Это первая задача и с ней вроде справился, вот код:
[vba]

Код

Public Sub CopyRows()
    Dim irow&, nrow&
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
        nrow = Selection.Rows.Count
    Application.ScreenUpdating = False
    irow = Selection.Row
    .Cells(irow, 1).Resize(nrow, 10).Copy
    Application.ScreenUpdating = True
    End With
End Sub

[/vba]
А вот со вставкой возникли сложности, вылетает ошибка. Мне нужно в строку где установлен курсор и ниже вставить диапазон ячеек из буфера. Ниже один из вариантов кода, который пытаюсь использовать. Применял разные варианты, причем даже записанный макрорекордером, при повторном запуске выдает ошибку. Причем после попытки запуска макроса не работает сочетание Ctrl+V, но при этом буфер обмена не очищается, т.е. какая то проблема с буфером
[vba]

Код

Public Sub PasteRows()
    Dim irow&
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    irow = Selection.Row
    .Cells(irow, 1).Paste

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End With
End Sub

[/vba]
Помогие, пожалуйста, решить проблему, много искал обсуждения подобных вопросов на просторах инета, но ничего подходящего не увидел.
И не могу не задать еще мучительный для себя вопрос: возможно ли в макросе копирования в буфер выбирать не только сплошной связанный диапазон, а также отдельные несвязанные строки (ячейки) (как помечаю много ячеек при нажатом Ctrl)?
В приложенном файле видно, что копирование в буфер работает, а вставка (несколько строк ниже) не работает.
Спасибо.

Код

К сообщению приложен файл: 5062679.xls (46.5 Kb)

Ответить

СообщениеДоброго времени суток, уважаемые форумчане! Думал, что операция копирования-вставки получится просто как палка-веревка, а получилось как всегда, т.е. не получается без обращения за помощью на любимый форум. Задача такая... есть две таблицы, в одной таблице я выделяю несколько ячеек по строкам (по вертикали) и макросом в буфер обмена копирую требуемый диапазон. Это первая задача и с ней вроде справился, вот код:
[vba]

Код

Автор - Markovich
Дата добавления - 21.02.2021 в 13:27

Markovich

Дата: Вторник, 23.02.2021, 00:08 | Сообщение № 2

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

Ранг: Участник

Сообщений: 50

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

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

Excel 2019

Товарищи, форумчане, подскажите, пожалуйста, почему не работает вставка из буфера, что я делаю неправильно? макрорекордер записывает:
[vba]

Код

Sub Макрос2()
Range("A29").Select
ActiveSheet.Paste
End Sub

[/vba]
а при повторном запуске не работает (снимается выделение ячейки), всю голову уже сломал

Сообщение отредактировал Markovich - Вторник, 23.02.2021, 00:24

Ответить

probkinfeda

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

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

Ранг: Новичок

Сообщений: 25

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

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

Вы написали много лишнего
Ошибка возникает из-за строки
[vba]

Код

Application.Calculation = xlCalculationManual

[/vba]

[vba]

Код

Public Sub CopyRows()
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
        Selection.Copy
    End With
End Sub
Public Sub PasteRows()
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
    .Paste
    End With
End Sub

[/vba]

Сообщение отредактировал probkinfeda - Вторник, 23.02.2021, 09:14

Ответить

Markovich

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

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

Ранг: Участник

Сообщений: 50

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

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

Excel 2019

probkinfeda, большое Вам спасибо! Уже думал, что не смогу преодолеть это препятствие. Первый макрос (копирование) оставил без изменений, т.к. мне нужно чтобы в буфер копировался диапазон ячеек в строке или строках которого находится курсор, а макрос вставки работает правильно. Объясните, пожалуйста, почему не работал макрос записанный рекордером, там нет строки:
[vba]

Код

Application.Calculation = xlCalculationManual

[/vba]
Спасибо

Ответить

Markovich

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

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

Ранг: Участник

Сообщений: 50

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

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

Excel 2019

И все-таки пытаюсь немного усложнить макрос вставки, чтобы вставка происходила начиная с ячейки первого столбца ("A") строки, в которой находится курсор, независимо от того, в какой ячейке находится курсор. При запуске кода выпадает ошибка. Подскажите, пожалуйста, в чем ошибка
[vba]

Код

Public Sub PasteRows1()
    Dim irow&
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
    Application.ScreenUpdating = False
    '.Paste
    irow = Selection.Row
    .Cells(irow, 1).Paste
    Application.ScreenUpdating = True
    End With
End Sub

[/vba]
Спасибо.

Сообщение отредактировал Markovich - Вторник, 23.02.2021, 10:35

Ответить

probkinfeda

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

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

Ранг: Новичок

Сообщений: 25

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

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

[vba]

Код

Public Sub PasteRows1()
    Dim irow&
    With Sheets("Лист1")
        If Selection.Row < 11 Then MsgBox "Неверное положение курсора": Exit Sub
    Application.ScreenUpdating = False
    '.Paste
    irow = Selection.Row
    .Cells(irow, 1).select
.Paste
    Application.ScreenUpdating = True
    End With
End Sub

[/vba]

Ответить

Markovich

Дата: Вторник, 23.02.2021, 11:55 | Сообщение № 7

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

Ранг: Участник

Сообщений: 50

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

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

Excel 2019

Работает! probkinfeda, еще раз большое спасибо!

Ответить

Копирование и вставка через буфер обмена двумя макросами (Макросы/Sub)

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