Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как вставить скопированные ячейки только в видимые/отфильтрованные ячейки

 

Ни для кого не секрет, что Excel позволяет выделять только видимые строки. Например, если некоторые из них скрыты или к ним применен фильтр.

если кто-то не знает, как это сделать: выделяем диапазон - Alt+;(для английской раскладки);Alt+ж(для русской). Подробнее можно почитать в этой статье

Если после выделения только видимых ячеек их скопировать, то скопируются они как положено. Но при попытке вставить скопированное в отфильтрованный диапазон(либо содержащий скрытые строки) - то результат вставки будет не совсем такой, как Вы ожидали. Данные будут вставлены даже в скрытые строки. Либо как вариант получим ошибку "Данная команда не применима к несвязанному диапазону".

Копируем единый диапазон ячеек и вставляем только в видимые
Чтобы данные вставлялись только в видимые ячейки, можно применить такой макрос:

Option Explicit
Dim rCopyRange As Range
'Этим макросом копируем данные
Sub My_Copy()
    If Selection.Count > 1 Then
        Set rCopyRange = Selection.SpecialCells(xlVisible)
    Else: Set rCopyRange = ActiveCell
    End If
End Sub
'Этим макросом вставляем данные, начиная с выделенной ячейки
Sub My_Paste()
    If rCopyRange Is Nothing Then Exit Sub
    If rCopyRange.Areas.Count > 1 Then MsgBox "Вставляемый диапазон не должен содержать более одной области!", vbCritical, "Неверный диапазон": Exit Sub
    Dim rCell As Range, li As Long, le As Long, lCount As Long, iCol As Integer, iCalculation As Integer
    Application.ScreenUpdating = False
    iCalculation = Application.Calculation: Application.Calculation = -4135
    For iCol = 1 To rCopyRange.Columns.Count
        li = 0: lCount = 0: le = iCol - 1
        For Each rCell In rCopyRange.Columns(iCol).Cells
            Do
                If ActiveCell.Offset(li, le).EntireColumn.Hidden = False And _
                   ActiveCell.Offset(li, le).EntireRow.Hidden = False Then
                    rCell.Copy ActiveCell.Offset(li, le)
                    lCount = lCount + 1
                End If
                li = li + 1
            Loop While lCount >= rCell.Row - rCopyRange.Cells(1).Row
        Next rCell
    Next iCol
    Application.ScreenUpdating = True: Application.Calculation = iCalculation
End Sub

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA(Alt+F11) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -выделяем имя макроса -Выполнить(Run).
Для полноты картины, данные макросы лучше назначить на горячие клавиши(в приведенных ниже кодах это делается автоматически при открытии книги с кодом). Для этого приведенные ниже коды необходимо просто скопировать в модуль ЭтаКнига(ThisWorkbook):

Option Explicit
'Отменяем назначение горячих клавиш перед закрытием книги
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^q": Application.OnKey "^w"
End Sub
'Назначаем горячие клавиши при открытии книги
Private Sub Workbook_Open()
    Application.OnKey "^q", "My_Copy": Application.OnKey "^w", "My_Paste"
End Sub

Теперь можно скопировать нужный диапазон нажатием клавиш Ctrl+q, а вставить его в отфильтрованный - Ctrl+w.
Если необходимо переносить только значения(т.е. если в ячейке будут формулы, то в итоге будет перенесен результат вычисления этой формулы), надо заменить строку в коде:

rCell.Copy ActiveCell.Offset(li, le)

на такую:

ActiveCell.Offset(li, le) = rCell.Value

Скачать пример

  Tips_Macro_CopyPasteInHiddenRows.xls (46,5 KiB, 14 943 скачиваний)


Копируем только видимые ячейки и вставляем только в видимые
По многочисленным просьбам доработал код. Теперь возможно копировать любые диапазоны: со скрытыми строками, скрытыми столбцами и вставлять скопированные ячейки также в любые диапазоны: со скрытыми строками, скрытыми столбцами. Работает совершенно так же, как и предыдущий: нажатием клавиш Ctrl+q копируем нужный диапазон(со скрытыми/отфильтрованными строками и столбцами или не скрытыми), а вставляем сочетанием клавиш Ctrl+w. Вставка производится так же в скрытые/отфильтрованные строки и столбцы или без скрытых.
Если в копируемом диапазоне присутствуют формулы, то во избежание смещения ссылок можно копировать только значения ячеек - т.е. при вставке значений будут вставлены не формулы, а результат их вычисления. Или если необходимо сохранить форматы ячеек, в которые происходит вставка - будут скопированы и вставлены только значения ячеек. Для этого надо заменить строку в коде(в файле ниже):

rCell.Copy rResCell.Offset(lr, lc)

на такую:

rResCell.Offset(lr, lc) = rCell.Value

В файле ниже обе эти строки присутствуют, Вам надо лишь оставить ту, которая больше подходит под Ваши задачи.

Скачать пример:

  Tips_Macro_CopyPasteInHiddenCells.xls (54,5 KiB, 13 737 скачиваний)

Так же см.:
Excel удаляет вместо отфильтрованных строк - все?! Как избежать


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 94 комментария
  1. Катя:

    Очень круто, большое спасибо)

  2. Сергей:

    Прежде всего спасибо за макрос - супер.

    Но появился маленький вопросик, можно приспособить данный макрос к работе в защищенных листах? Понятное дело, область вставки не заблокирована.

  3. Антон:

    Офигенный макрос!! Спасибо большое! Просто спас жизнь))))

  4. Дмитрий:

    Добрый день. Имеется макрос по замене местами значений в крайних ячейках, он работает только на неотфильтрованном диапазоне

    Sub SwapAreas() 
    Dim bSecond As Boolean, rX As Range, r2 As Range, v 
    If Selection.Areas.Count  2 Then MsgBox "Число выделенных областей не равно 2.", vbCritical: Exit Sub 
    For Each rX In Selection.Areas 
    If bSecond Then 
    v = rX 
    r2.Copy rX 
    r2 = v 
    Else 
    bSecond = True 
    Set r2 = rX 
    End If 
    Next 
    End Sub

    Есть ли возможность сделать так, чтобы это работало и с отфильтрованными ячейками?

  5. Ирина:

    Дмитрий, добрый день.
    Вставила макрос - запускаю, но прога выдает "Вставляемый диапазон не должен содержать более одной области". Не могу понять, где ошиблась - помогите,пжста.
    1. скопировала макрос,сохранила
    2.фильтрую таблицу -выделяю столбец, пускаю my copy
    3. в целевой таблице выделяю столбец, в который хочу вставить - пускаю my paste
    ---> сообщение об ошибке.
    как быть?

    заранее спасибо

  6. Сергей:

    Уважаемый Дмитрий!
    Макрос "КОПИРУЕМ ТОЛЬКО ВИДИМЫЕ ЯЧЕЙКИ И ВСТАВЛЯЕМ ТОЛЬКО В ВИДИМЫЕ" очень удобный, спасибо за него! Но есть одна просьба: нельзя ли добавить в него помимо копирования значения еще и копирование формата ячеек. Ответ можно отправить на почту kroha2303@mail.ru

    • Комментарии на то и комментарии, чтобы отвечать для всех, а не для Вас лично Вам на почту.
      В исходном виде код и так копирует и форматы и все остальное. Чтобы вставлять только форматы и значения(без формул) можно вместо строки:

      rCell.Copy ActiveCell.Offset(li, le): lCount = lCount + 1

      использовать такие строки:

      rCell.Copy
      ActiveCell.Offset(li, le).PasteSpecial xlValues
      ActiveCell.Offset(li, le).PasteSpecial xlFormats
      lCount = lCount + 1
  7. Сергей:

    Уважаемый Дмитрий!
    Спасибо за ответ, но я использую макрос из примера и там нет такой строчки
    rCell.Copy ActiveCell.Offset(li, le): lCount = lCount + 1
    Там вот такие строчки
    If rResCell.Offset(lr, lc).EntireColumn.Hidden = False And _
    rResCell.Offset(lr, lc).EntireRow.Hidden = False Then
    rResCell.Offset(lr, lc) = rCell.Value
    End If
    lr = lr + 1
    Поясните, что заменить здесь.
    Извините за безграммотность.

    • rResCell.Offset(lr, lc) = rCell.Value

      на

      rCell.Copy
      rResCell.Offset(lr, lc).PasteSpecial xlValues
      rResCell.Offset(lr, lc).PasteSpecial xlFormats
  8. Сергей:

    Дмитрий, спасибо!
    Все получилось!

  9. Огромное спасибо. Вы очень помогли. Я поддержу развитие Вашего сайта.

  10. Владимир:

    Просто праздник какой-то!

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти