Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/21: Рейтинг темы: голосов - 21, средняя оценка - 4.57
caustic
18 / 18 / 0
Регистрация: 30.09.2011
Сообщений: 283
#1

Копирование строк заданное число раз

19.12.2012, 11:14. Просмотров 4029. Ответов 7
Метки нет (Все метки)

Добрый день.

подскажите пожалуйста:

как скопировать и вставить (как показано на вкладке "как должно быть") четыре раза строчки из вкладки "лист1"?


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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub vot_tak()
 
    Dim lLastRow As Long
 
    lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    Range("B2:B" & lLastRow).Select
    Selection.Copy
Range("B" & 1 + lLastRow).Select
ActiveSheet.Paste
    
    Range("B2:B" & lLastRow).Select
Range("B" & 1 + lLastRow).Select
ActiveSheet.Paste
 
End Sub
0
Вложения
Тип файла: xls Книга2 - копия.xls (27.5 Кб, 60 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
19.12.2012, 11:14
Ответы с готовыми решениями:

Копирование строк в n-раз
Уважаемые знатоки VBA прошу вашей помощи и поддержку в решении задачи ест...

Массив: Вывод на экран номеров строк массива, где число x встречается хотя бы один раз.
Всем привет :) Решил порешать типовые задачки, ответов, к сожалению не нашел....

Сравнение строк в нескольких файлах excel, копирование несовпадающих строк и их вывод в сводный файл
Добрый день, только только начал разбираться с VBA в excel, поэтому прошу...

Найти среди чисел последовательности самое первое число, превосходящее заданное число а
найти среди чисел последовательности 1,1+1/2,1+1/2+1/3,...самое первое число ,...

Уменьшить количество забитых шайб на заданное число, если это число больше 0
Привет. В ячейки K7 появляется общее количество забитых шайб. По нажатию на...

7
Скрипт
5444 / 1125 / 49
Регистрация: 15.09.2012
Сообщений: 3,416
19.12.2012, 12:33 #2
Код:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Procedure_1()
 
    Dim rCopyRange As Excel.Range
    Dim lLastRow As Long
    Dim lRowsCount As Long
    Dim i As Long
    
    '1. Определяем последнюю строку с данными в столбце "B".
    'What:="?" - знак вопроса в данном случае - это специальный знак.
    'LookAt:=xlPart - частичное совпадение.
    'SearchDirection:=xlPrevious - поиск с конца в начало.
    lLastRow = Columns("B").Find(What:="?", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row
 
    '2. Даём имя копируемому диапазону. Через
    'это имя будем обращаться к копируемому диапазону.
    Set rCopyRange = Range("B2:B" & lLastRow)
    
    '3. Узнаём, сколько строк будет копироваться и помещаем это число
    'в переменную, чтобы каждый раз не обращаться к объекту.
    lRowsCount = rCopyRange.Rows.Count
    
    '4. Копирование данных.
    'Если нужно сделать несколько раз одно и то же действие,
    'нужно использовать цикл.
    For i = 1 To 4 Step 1
    
        'Копирование нужно использовать только тогда, когда
        'нужно скопировать оформление текста: цвет шрифта, размер шрифта и др.
        'Поэтому я не буду использовать в данном случае копирование.
        Range("B" & lLastRow + 1 & ":B" & lLastRow + lRowsCount).Value = _
            rCopyRange.Value
            
        'Изменяем число в переменной "lLastRow".
        lLastRow = lLastRow + lRowsCount
 
    Next i
    
End Sub
2
caustic
18 / 18 / 0
Регистрация: 30.09.2011
Сообщений: 283
19.12.2012, 12:46  [ТС] #3
Цитата Сообщение от Скрипт Посмотреть сообщение
Код:
отличный макрос. особенно порадовало подробное описание действий. очень поможет в дальнейшем
0
Скрипт
5444 / 1125 / 49
Регистрация: 15.09.2012
Сообщений: 3,416
19.12.2012, 13:12 #4
Из сообщения #2 в коде строку 32 можно заменить на эту, чтобы код было проще читать и писать:
Visual Basic
1
        Range("B" & lLastRow + 1).Resize(lRowsCount, 1).Value = rCopyRange.Value

Вариант с использованием средств автоматического заполнения самой программы Excel:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Procedure_1()
 
    Dim lRowsCount As Long
    
    '1. Помещаем в переменную количество копируемых строк.
    lRowsCount = Range("B2:B10").Rows.Count
    
    '2. Заполняем средствами программы Excel.
    'Часть кода получена с помощью макрорекордера при
    'выполнениее следующих действий в Excel 2010:
        'а) Выделил диапазон "B2:B19";
        'б) вкладка "Главная" - группа "Редактирование" - "Заполнить" - "Прогрессия";
        'в) "Автозаполнение" - "OK".
    Range("B2").Resize(lRowsCount * 5, 1).DataSeries _
        Rowcol:=xlColumns, Type:=xlAutoFill, Trend:=False
    
End Sub
1
kubhome
0 / 0 / 0
Регистрация: 08.10.2012
Сообщений: 2
19.12.2012, 13:22 #5
Макрос копирует ячейки заданное число раз.
А что нужно изменить, чтобы копировал именно строки?
0
Скрипт
5444 / 1125 / 49
Регистрация: 15.09.2012
Сообщений: 3,416
19.12.2012, 13:44 #6
Цитата Сообщение от kubhome Посмотреть сообщение
А что нужно изменить, чтобы копировал именно строки?
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Procedure_1()
 
    Dim rCopyRange As Excel.Range
    Dim lLastRow As Long
    Dim lRowsCount As Long
    Dim i As Long
    
    '1. Определяем последнюю строку с данными в столбце "B".
    lLastRow = Columns("B").Find(What:="?", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row
 
    '2. Даём имя копируемому диапазону.
    Set rCopyRange = Rows("2:" & lLastRow)
    
    '3. Узнаём, сколько строк будет копироваться.
    lRowsCount = rCopyRange.Rows.Count
    
    '4. Копирование данных.
    For i = 1 To 4 Step 1
    
        Rows(lLastRow + 1 & ":" & lLastRow + lRowsCount).Value = rCopyRange.Value
            
        'Изменяем число в переменной "lLastRow".
        lLastRow = lLastRow + lRowsCount
 
    Next i
    
End Sub
2
kubhome
0 / 0 / 0
Регистрация: 08.10.2012
Сообщений: 2
19.12.2012, 15:11 #7
Работает отлично. Спасибо!
0
Zzebra
0 / 0 / 0
Регистрация: 23.03.2018
Сообщений: 1
24.04.2018, 20:21 #8
Скрипт, прошу у вас помощи я не очень сильна в ВБА, мне нужен макрос, который копировал диапазон ячеек, столько раз сколько я укажу например через форму? буду вам признательна, за помощь
0
24.04.2018, 20:21
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.04.2018, 20:21

Определить, сколько раз в строке встречается заданное слово
Здравствуйте .помогите пожалуйста решить задачку!!!! Определить, сколько раз в...

Копирование строчки n раз с информацией
Добрый день, друзья! Помогите с макросом: Копирует одну строчку (5-ю),...

Копирование листа > 255 раз
Sheets("ффф").Copy before:=Sheets(page_ + 1) Excel позволяет выполнить...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru