Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование, со вставкой новых строк - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование, со вставкой новых строк (Макросы/Sub)
Копирование, со вставкой новых строк
IgorStorm Дата: Пятница, 19.02.2016, 21:01 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Всем привет. Затерялся мой пост на планете, спрошу еще здесь. Если что кросс: здесь

Прошу помочь добить макрос копирования со вставкой новых строк. Файл с тем что хочу получить вложил, там есть наброски макросов, но до конца они работу не доводят (новые строки вставляются как нужно, а как перенести скопированное пока не соображу)

Поясню суть зачем это нужно: - часто приходится вставлять в готовые таблицы некие статичные данные, которые с двух сторон окружены ВПР-ами и после вставки формулы просто протягиваются. Не добавляем в конец, потому что так проще потом протянуть и не надо менять диапазоны в формулах и сводных.

Пытаюсь сделать универсальное решение - из любого места скопировал, в любое вставил. Решение делится на два этапа - одним макросом скопировал, другим вставил. Если можно обойтись без спец. копирования - будет круто.
К сообщению приложен файл: 1645710.xlsm (18.2 Kb)
 
Ответить
СообщениеВсем привет. Затерялся мой пост на планете, спрошу еще здесь. Если что кросс: здесь

Прошу помочь добить макрос копирования со вставкой новых строк. Файл с тем что хочу получить вложил, там есть наброски макросов, но до конца они работу не доводят (новые строки вставляются как нужно, а как перенести скопированное пока не соображу)

Поясню суть зачем это нужно: - часто приходится вставлять в готовые таблицы некие статичные данные, которые с двух сторон окружены ВПР-ами и после вставки формулы просто протягиваются. Не добавляем в конец, потому что так проще потом протянуть и не надо менять диапазоны в формулах и сводных.

Пытаюсь сделать универсальное решение - из любого места скопировал, в любое вставил. Решение делится на два этапа - одним макросом скопировал, другим вставил. Если можно обойтись без спец. копирования - будет круто.

Автор - IgorStorm
Дата добавления - 19.02.2016 в 21:01
IgorStorm Дата: Пятница, 19.02.2016, 23:58 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Что-то такое получилось. Вроде работает.

[vba]
Код
Dim CntS, rn As Range
Dim rCopyRange As Range
Dim CnA

Sub Копировать()
    If Selection.Count > 1 Then
        Set rCopyRange = Selection.Cells
    Else: Set rCopyRange = ActiveCell
    End If
      CntS = Selection.Rows.Count
End Sub

Sub Вставить()
On Error Resume Next
    Dim rCell As Range, li As Long, le As Long, lCount As Long, iCol As Integer
    Dim sA As String
Cntt = ActiveCell.Row
sA = ActiveCell.Address
ActiveSheet.Rows(Cntt).Resize(CntS).Insert
    For iCol = 1 To rCopyRange.Columns.Count
        li = 0: lCount = 0: le = iCol - 1
        For Each rCell In rCopyRange.Columns(iCol).Cells
            Do
                    rCell.Copy ActiveCell.Offset(li, le): lCount = lCount + 1
                li = li + 1
            Loop While lCount <= 0
        Next rCell
    Next iCol
End Sub
[/vba]


Сообщение отредактировал IgorStorm - Пятница, 19.02.2016, 23:59
 
Ответить
СообщениеЧто-то такое получилось. Вроде работает.

[vba]
Код
Dim CntS, rn As Range
Dim rCopyRange As Range
Dim CnA

Sub Копировать()
    If Selection.Count > 1 Then
        Set rCopyRange = Selection.Cells
    Else: Set rCopyRange = ActiveCell
    End If
      CntS = Selection.Rows.Count
End Sub

Sub Вставить()
On Error Resume Next
    Dim rCell As Range, li As Long, le As Long, lCount As Long, iCol As Integer
    Dim sA As String
Cntt = ActiveCell.Row
sA = ActiveCell.Address
ActiveSheet.Rows(Cntt).Resize(CntS).Insert
    For iCol = 1 To rCopyRange.Columns.Count
        li = 0: lCount = 0: le = iCol - 1
        For Each rCell In rCopyRange.Columns(iCol).Cells
            Do
                    rCell.Copy ActiveCell.Offset(li, le): lCount = lCount + 1
                li = li + 1
            Loop While lCount <= 0
        Next rCell
    Next iCol
End Sub
[/vba]

Автор - IgorStorm
Дата добавления - 19.02.2016 в 23:58
al-Ex Дата: Суббота, 20.02.2016, 02:40 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Пытаюсь сделать универсальное решение - из любого места скопировал, в любое вставил
Ну вот так, мне нравится.
[vba]
Код
Dim CntS as Integer
Dim rn As Range
Dim rd As Range

Sub Копирование() 'выбираем диапазон-источник
   Set rn = Selection ' Диапазон-источник
CntS = Selection.Rows.Count 'кол-во строк
UserForm1.Show 'диалог для выбора места вставки
End Sub

Sub Вставка() ' после выбора диапазона-приёмника
Application.CutCopyMode = False
ActiveCell.Resize(CntS).EntireRow.Insert 'вставляет нужное кол. строк
   Set rd = Selection                 'диапазон-приёмник
rn.Copy Destination:=rd 'Копирует диапазон-источник в диапазон-приёмник
End Sub
[/vba]
Еще диалог вставил для удобства,
в файле посмотри.
кнопку "Копирование" в ленте еще сделаешь и ОК.
К сообщению приложен файл: 1645710_my.xlsm (22.1 Kb)


Сообщение отредактировал al-Ex - Суббота, 20.02.2016, 03:57
 
Ответить
Сообщение
Пытаюсь сделать универсальное решение - из любого места скопировал, в любое вставил
Ну вот так, мне нравится.
[vba]
Код
Dim CntS as Integer
Dim rn As Range
Dim rd As Range

Sub Копирование() 'выбираем диапазон-источник
   Set rn = Selection ' Диапазон-источник
CntS = Selection.Rows.Count 'кол-во строк
UserForm1.Show 'диалог для выбора места вставки
End Sub

Sub Вставка() ' после выбора диапазона-приёмника
Application.CutCopyMode = False
ActiveCell.Resize(CntS).EntireRow.Insert 'вставляет нужное кол. строк
   Set rd = Selection                 'диапазон-приёмник
rn.Copy Destination:=rd 'Копирует диапазон-источник в диапазон-приёмник
End Sub
[/vba]
Еще диалог вставил для удобства,
в файле посмотри.
кнопку "Копирование" в ленте еще сделаешь и ОК.

Автор - al-Ex
Дата добавления - 20.02.2016 в 02:40
IgorStorm Дата: Суббота, 20.02.2016, 07:09 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
al-Ex, Спасибо Вам за лаконичный вариант. hands Воспользуюсь. Вместо UserForm у меня будут пункты в контекстном меню ячейки.
 
Ответить
Сообщениеal-Ex, Спасибо Вам за лаконичный вариант. hands Воспользуюсь. Вместо UserForm у меня будут пункты в контекстном меню ячейки.

Автор - IgorStorm
Дата добавления - 20.02.2016 в 07:09
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование, со вставкой новых строк (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!