Как скопировать выбранный диапазон ячеек в VBA?

Вопрос или проблема

Я относительно новичок в VBA. Мне удалось выделить верхние 20 строк рабочего листа после применения фильтра. Теперь я пытаюсь переместить эти 20 строк на новый лист, но постоянно получаю ошибки.

Вот код, который у меня есть:

Sub TwentyRows()
    Dim rng As Range
    Dim rngF As Range
    Dim rng10 As Range

    Set rngF = Range("A16:H520").SpecialCells(xlCellTypeVisible)

    For Each rng In Range("A16:H520")
        If Not Intersect(rng, rngF) Is Nothing Then
            If rng10 Is Nothing Then
                Set rng10 = rng
            Else
                Set rng10 = Union(rng10, rng)
            End If
            If rng10.Cells.Count = 140 Then Exit For
        End If
    Next rng
    Debug.Print rng10.Address
    '.. $F$1:$F$2,$F$4:$F$5,$F$9:$F$10,$F$12,$F$20:$F$21,$F$23
    twenty_rows = rng10.Select
    Range(rng10.Select).Copy Worksheets("Sheet2").Range("A1")

Две последние строки являются причиной проблемы, так как сейчас написано, что “Метод ‘Range’ объекта ‘_Global’ не удался.” Я пытаюсь просто взять тот выбор, сделанный с помощью rng10.Select, и скопировать его на новый лист.

Ответ или решение

Чтобы скопировать выбранный диапазон ячеек в VBA без использования метода Select, можно упростить и исправить ваш код. Метод Select не требуется, когда вы работаете с диапазонами в VBA. Вместо этого вы можете напрямую использовать объект диапазона.

Вот исправленная версия вашего кода:

Sub TwentyRows()
    Dim rng As Range
    Dim rngF As Range
    Dim rng10 As Range
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    ' Установите рабочие листы
    Set wsSource = ThisWorkbook.Worksheets("Sheet1") ' Убедитесь, что имя листа правильное
    Set wsDest = ThisWorkbook.Worksheets("Sheet2")

    ' Получите видимые ячейки в диапазоне
    Set rngF = wsSource.Range("A16:H520").SpecialCells(xlCellTypeVisible)

    ' Соберите первые 20 видимых строк
    For Each rng In rngF
        If rng10 Is Nothing Then
            Set rng10 = rng
        Else
            Set rng10 = Union(rng10, rng)
        End If
        If rng10.Cells.Count = 140 Then Exit For
    Next rng

    ' Копирование диапазона rng10 в новый лист в ячейку A1
    If Not rng10 Is Nothing Then
        rng10.Copy Destination:=wsDest.Range("A1")
    Else
        MsgBox "Не найдено видимых строк для копирования."
    End If
End Sub

Объяснение изменений:

  1. Установлены рабочие листы: Код теперь использует переменные wsSource и wsDest, чтобы четко указать, с каким листом мы работаем.

  2. Копирование диапазона: Вместо Range(rng10.Select).Copy Worksheets("Sheet2").Range("A1"), мы используем rng10.Copy Destination:=wsDest.Range("A1"), что значительно упрощает процесс копирования и устраняет необходимость в использовании Select.

  3. Проверка на наличие видимых строк: Добавлена проверка: если rng10 остается пустым (то есть нет подходящих ячеек для копирования), то выдается сообщение об этом.

Этот алгоритм позволяет вам избежать проблем с методом Select и повышает производительность вашего кода. Попробуйте запустить его и убедитесь, что он корректно копирует данные на новый лист!

Оцените материал
Добавить комментарий

Капча загружается...