Страницы: 1
RSS
Объединить копируемые диапазоны в один с последующей вставкой в разные диапазоны
 
Всем привет!
Есть следующий код, копирования ячеек
Код
Sub копи()

With Sheets("Опоры")
    Range("I3").Copy .Range("I4:I2000")
    Range("K3:N3").Copy .Range("K4:N2000")
    Range("AN3").Copy .Range("AN4:AN2000")
    Range("AP3").Copy .Range("AP4:AP2000")
    Range("BL3:BX3").Copy .Range("BL4:BX2000")
End With

End Sub
Но мне кажется это немного топорно, в каждой строке прописывать Range.  
Есть объект Union, но не совсем понимаю, как его применить, если это вообще возможно
 
Объединить-то можно в один, но диапазоны вставки разные.
Вы бы задачу описали.

А так...
Код
Sub CopyRange()
    Dim aColumn()
    Dim lClmn As Long, lCnt As Long
    Dim j As Long
    
    aColumn = Array("I3:I3", "K3:N3", "AN3:AN3", "AP3:AP3", "BL3:BX3")
    
    With Sheets("Опоры")
        For j = 0 To UBound(aColumn)
            lClmn = Range(aColumn(j)).Column ' первый столбец диапазона
            lCnt = Range(aColumn(j)).Columns.Count  ' количество столбцов в диапазоне
            
            Cells(3, lClmn).Resize(1, lCnt).Copy .Cells(4, lClmn).Resize(1997, lCnt)
        Next j
    End With
End Sub
 
Задача простая, скопировать данные из диапазонов "I3" в "I4:I2000"   "K3:N3" в "K4:N2000" и т.д. то-есть я его реализовал кодом, в моем сообщении, но мне кажется мой код немного топорный и можно убрать повторы метода Range, то есть что то типо
Код
Range("I3", "K3:N3", "AN3").Copy .Range("I4:I2000", "K4:N2000", "AN4:AN2000")
а из вашего сообщения понял, что метод Union вставляет объединенные ячейки, и он не подойдет
 
Цитата
adamm написал: метод Union вставляет объединенные ячейки
Не путайте понятия.
Объединенные ячейки - диапазон ячеек, объединенных в одну ячейку. А Union объединяет диапазоны (одна ячейка - тоже диапазон) в один диапазон.

В Вашем случае можно исходные диапазоны объединить в один, а потом вычислять их положение и количество столбцов. Что я и сделал с помощью массива. Но если исходных 3-5, не стоит заморачиваться.
 
ок, спасибо!
 
Цитата
vikttur написал:  можно исходные диапазоны объединить в один, а потом вычислять их положение
Можно.  :D
А может
Цитата
vikttur написал: не стоит заморачиваться
Код
Sub мяу()
    For Each ar In Range("I3, K3:N3, AN3:AN3, AP3, BL3:BX3").Areas
        ar.Copy ar.Offset(1).Resize(1997)
    Next
End Sub
 
Ого... Таки да )
 
Погорячился, был не прав. Немного заморочиться стоит.
Код
Sub мяу()
    For Each ar In Range("I3, K3:N3, AN3:AN3, AP3, BL3:BX3").Areas
        ar.Copy Sheets(2).Range(ar.Address).Offset(1).Resize(97)
    Next
End Sub
 
RAN, ого только заметил попробую спасибо!
Изменено: adamm - 27.09.2019 09:40:19
 
Цитата
adamm написал: попробую спасибо!
Зуб не поломайте :)
Страницы: 1
Наверх