Excel копировать с другого листа макрос - Word и Excel - помощь в работе с программами

spawnloko

Пользователь

Сообщений: 45
Регистрация: 01.01.1970

02.10.2014 13:28:05

Добрый день.
Не получается сделать копирование с одного листа на другой, чтобы значения вставлялись после последней заполненной ячейки в столбце А.
При этом копирование с других листов осуществляется с ячейки А20.
Подскажите, пожалуйста, что в этом коде не так, или как вообще лучше написать его.

Код
Sheets(2).Range("A20:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("Лист1" ;) .Range("A" & Cells(Rows.Count, 1) + 1).End(xlUp).Row

Спасибо

Изменено: spawnloko — 02.10.2014 14:06:33

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012	Перед Cells (и Rows желательно тоже) нужно явно указать кто родитель (т.е. чьё).

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

02.10.2014 14:08:41

Код
With Sheets("Лист1") Sheets(2).Range("A20:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) End With

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	Sheets(«Лист1»).Range(«A» & Cells(Rows.Count, 1).End(xlUp).Row+1)

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012	Юра — а если активен Лист3? Кузмич — а если активен не Лист1? А вообще — конечно нужно посмотреть где расположен этот код. Отсюда не видно…

Юрий М Модератор Сообщений: 60570 Регистрация: 14.09.2012 Контакты см. в профиле

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

02.10.2014 14:22:35

Тогда вот так:

Код
With Sheets("Лист1") Sheets(2).Range("A20:A" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) End With

spawnloko Пользователь Сообщений: 45 Регистрация: 01.01.1970	Юрий М,Kuzmich, Hugo, Спасибо Вам!

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012	А если копировать между двумя книгами — то ещё и чьё Rows.count нужно указать для надёжности — были случаи когда в xls искали миллион… Или наоборот — в xlsx/xlsm/xlsb смотрели не с конца листа.

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

#10

02.10.2014 14:48:34

Цитата
Hugo пишет: были случаи когда в xls искали миллион…

kipf

Пользователь

Сообщений: 22
Регистрация: 15.10.2015

Добры день разбираюсь так себе но хотелось бы готовое решение. Перенос данных с Листа 1 не кой таблицы переносился на Лист 2 с помощью кнопки в строку последнюю не заполненную то есть на Листе 2 есть некая таблица она меняется каждый день по кол-ву строк после нее надо вставлять таблицу с Листа 1, да на Листе 1 тоже таблица каждый день может изменятся по кол-ву строк. Помогите буду благодарен

Прикрепленные файлы

Книга1.xlsm (24.02 КБ)

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

#12

12.11.2015 19:35:08

Код

Sub Макрос1()
Dim FreeRow As Long
    With Sheets("Лист1")
        FreeRow = Cells(Rows.Count, 2).End(xlUp).Row + 2
        Range(.Cells(7, 4), .Cells(.Cells(Rows.Count, 6).End(xlUp).Row, 12)).Copy Cells(FreeRow, 1)
    End With
End Sub

Но это будет копирование, а не перенос, как Вы написали. Или нужно именно переносить?

kipf Пользователь Сообщений: 22 Регистрация: 15.10.2015	Подскажите как сделать Юрий М

Юрий М Модератор Сообщений: 60570 Регистрация: 14.09.2012 Контакты см. в профиле	Я уже подсказал ) Скопируйте этот код в свой модуль.

kipf Пользователь Сообщений: 22 Регистрация: 15.10.2015	Юрий М ВАМ ОГРОМНОЕ СПАСИБО все так и надо все работает

kipf Пользователь Сообщений: 22 Регистрация: 15.10.2015	#16 20.11.2015 15:06:59 Помогите разобраться какой макрос можно использывать копировать данные из одной книги по названию фирмы в другую книгу по дате Прикрепленные файлы АРТЕМ.rar (44.52 КБ)

Источник

Решение задачи по копированию данных с одного листа на другой без использования и с использованием массивов. Вызов из кода VBA Excel других процедур.

Условие задачи по копированию данных

На одном листе расположен список повторяющихся городов с информацией о предприятиях общепита:

Исходная таблица задания №1

Необходимо данные по каждому городу перенести в одну строку на другом листе (таблица обрезана справа):

Часть результирующего списка задания №1

Решение копированием с листа на лист

Это решение значительно проще, чем с использованием массивов, но более медленное. При больших объемах информации обработка может длиться достаточно долго. Решение достигается путем присваивания значений ячеек из таблицы первого листа ячейкам второго листа.

Sub Resheniye1()

Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, _

i1 As Long, gorod As Variant

n1 = Sheets(«Лист1»).Cells(1, 1).CurrentRegion.Rows.Count

For i1 = 1 To n1

With Sheets(«Лист1»)

If gorod <> .Cells(i1, 1) Then

gorod = .Cells(i1, 1)

n2 = 1

n3 = n3 + 1

n4 = 1

Else

n2 = 2

End If

Do While .Cells(i1, n2) <> «»

Sheets(«Лист2»).Cells(n3, n4) = .Cells(i1, n2)

n4 = n4 + 1

n2 = n2 + 1

Loop

End With

End Sub

Переменные:

n1 – количество строк в исходной таблице;
n2 – номер столбца текущей ячейки исходной таблицы, к которой обращается цикл;
n3 – номер строки текущей ячейки на втором листе;
n4 – номер столбца текущей ячейки на втором листе;
i1 – счетчик цикла For… Next;
gorod – переменная с наименованием города, предназначенная для контроля за сменой текущего города, который обрабатывается циклом.

Решение с использованием массивов

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

‘Объявление глобальных переменных

‘в разделе Declarations

Dim massiv1 As Variant, n2 As Long, _

n3 As Long, i1 As Long, txt1 As Variant

‘Исполняемая процедура для решения

‘задания вторым способом

Sub Resheniye2()

Dim n1 As Long, gorod As Variant

With Sheets(«Лист1»).Cells(1, 1)

massiv1 = .CurrentRegion

n1 = .CurrentRegion.Rows.Count

n2 = .CurrentRegion.Columns.Count

End With

n3 = 0

txt1 = «»

For i1 = 1 To n1

If gorod <> massiv1(i1, 1) Then

If txt1 <> «» Then

Call Vstavka

End If

gorod = massiv1(i1, 1)

txt1 = massiv1(i1, 1)

Call Kopirovanie

Else

Call Kopirovanie

End If

If i1 = n1 Then

Call Vstavka

End If

End Sub

‘Копирование данных из массива в

‘строковую переменную через разделитель

Sub Kopirovanie()

Dim i2 As Long

For i2 = 2 To n2

If massiv1(i1, i2) <> Empty Then

txt1 = txt1 & «|» & massiv1(i1, i2)

End If

End Sub

‘Обработка данных из строковой

‘переменной в дополнительных массивах и

‘вставка очередной строки на второй лист

Sub Vstavka()

Dim n4 As Long, massiv2 As Variant, _

massiv3 As Variant, i3 As Long

n3 = n3 + 1

massiv2 = Split(txt1, «|»)

n4 = UBound(massiv2)

ReDim massiv3(0 To 0, 0 To n4)

For i3 = 0 To n4

massiv3(0, i3) = massiv2(i3)

Sheets(«Лист2»).Range(Cells(n3, 1), _

Cells(n3, n4 + 1)).Value = massiv3

End Sub

Подпрограммы Kopirovanie и Vstavka используются в цикле For... Next процедуры Resheniye2 по два раза, поэтому их коды вынесены за пределы процедуры Resheniye2 и вызываются по мере необходимости.

Переменные:

massiv1 – его элементам присваиваются значения ячеек исходной таблицы;
massiv2 – одномерный массив, заполняемый данными из переменной txt1;
massiv3 – двумерный массив, заполняемый данными из одномерного массива massiv2 и используемый для вставки очередной строки на второй лист;
txt1 – сюда копируются через разделитель значения элементов массива massiv1, предназначенные для заполнения очередной строки на втором листе;
n1 – количество строк в исходной таблице;
n2 – количество столбцов в исходной таблице;
n3 – номер текущей строки на втором листе;
n4 – количество столбцов текущей строки на втором листе (соответствует количеству элементов массива massiv2);
i1, i2, i3 – счетчики цикла For… Next;
gorod – переменная с наименованием города, предназначенная для контроля за сменой текущего города, который обрабатывается циклом.

Переменные, использующиеся более чем в одной процедуре, объявлены как глобальные в разделе Declarations программного модуля.

Источник

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

Excel

Макрос для копирования информации с одного листа на другой по определенным условиям

31.05.2019, 13:30. Показов 44321. Ответов 23

Доброго времени суток, Гуру excel!!!

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

Файл с примером прилагаю в нем все цветами выделено что копировать и куда вставлять.

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

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 13:31

А файл не приложили )

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 13:32

[ТС]

ArtNord, сейчас минутку

вот файл

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 13:43

Да, вижу, а что куда и по какому условию.
Все увидел внизу

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 13:45

[ТС]

то что желтым выделено это условия, а синим это нужно перенести на лист 2

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 14:07

Сообщение было отмечено Александр_80 как решение

Решение

Проверьте

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 14:08

Александр_80, проверьте

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 14:21

[ТС]

ArtNord, ДА ВСЕ РАБОТАЕТ ЭТО ПРОСТО МАГИЯ КАКАЯ ТО , ВОТ ТОЛЬКО Я ЗАБЫЛ УКАЗАТЬ НА КОЛОНКУ ДЮЙМЫ, МОЖНО ИХ ТОЖЕ КОПИРОВАТЬ? ПО ТЕМ ЖЕ УСЛОВИЯМ

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 14:25

Добавил

Александр_80

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 14:46

[ТС]

ArtNord, Вы просто супер!!!! Спасибо огромное вам!!!!! Еще одна просьба, вы не могли бы разъяснить по вашему макросу, что какая команда делает?

Visual Basic

Sub Копирование()
AllRecs = Application.WorksheetFunction.CountA(Sheets("1").Range("B:B"))
cAllRecs = Application.WorksheetFunction.CountA(Sheets("2").Range("B:B"))
    For CurRec = 2 To AllRecs
    AllCrit = Sheets("1").Cells(CurRec, 2) & "_" & Sheets("1").Cells(CurRec, 3) & "_" & Sheets("1").Cells(CurRec, 8)
 
        For cRecs = 2 To cAllRecs
            CheckKrit = Sheets("2").Cells(cRecs, 2) & "_" & Sheets("2").Cells(cRecs, 3) & "_" & Sheets("2").Cells(cRecs, 19)
            If AllCrit = CheckKrit Then
            Sheets("2").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11)
            Sheets("2").Cells(cRecs, 17) = Sheets("1").Cells(CurRec, 12)
            Sheets("2").Cells(cRecs, 18) = Sheets("1").Cells(CurRec, 13)
            Sheets("2").Cells(cRecs, 30) = Sheets("1").Cells(CurRec, 27)
            Sheets("2").Cells(cRecs, 29) = Sheets("1").Cells(CurRec, 30)
            Sheets("2").Cells(cRecs, 28) = Sheets("1").Cells(CurRec, 6)
            End If
        Next cRecs
    Next CurRec
End Sub

ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 14:57

Спасибо за оценку!

Visual Basic

Sub Копирование()
AllRecs = Application.WorksheetFunction.CountA(Sheets("1").Range("B:B")) ' Получение количества строк на листе 1 (подсчет значений в столбце B)
cAllRecs = Application.WorksheetFunction.CountA(Sheets("2").Range("B:B")) 'Аналогично для листа 2
For CurRec = 2 To AllRecs ' Начало цикла для Листа 1
AllCrit = Sheets("1").Cells(CurRec, 2) & "_" & Sheets("1").Cells(CurRec, 3) & "_" & Sheets("1").Cells(CurRec, 8) ' объединение 'всех критериев на Листе 1 в одну переменную
' Теперь эту "сумму критериев" ищем в Листе 2
For cRecs = 2 To cAllRecs ' Начало цикла для Листа 2
'Пробегаемся циклом по всем строкам Листа 2 сверяя сумму критериев на каждой строке с имеющейся суммой критериев
CheckKrit = Sheets("2").Cells(cRecs, 2) & "_" & Sheets("2").Cells(cRecs, 3) & "_" & Sheets("2").Cells(cRecs, 19) '  объединение 'всех критериев на Листе 2 в одну переменную
If AllCrit = CheckKrit Then 'сверка критериев если Они равны то:
'в этой строке указанным ячейкам присвоить значения из листа 1
Sheets("2").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11) 
Sheets("2").Cells(cRecs, 17) = Sheets("1").Cells(CurRec, 12)
Sheets("2").Cells(cRecs, 18) = Sheets("1").Cells(CurRec, 13)
Sheets("2").Cells(cRecs, 30) = Sheets("1").Cells(CurRec, 27)
Sheets("2").Cells(cRecs, 29) = Sheets("1").Cells(CurRec, 30)
Sheets("2").Cells(cRecs, 28) = Sheets("1").Cells(CurRec, 6)
End If 'конец условия
Next cRecs 'следующая строка на Листе2
'После  окончания проверки на Листе 2 возвращаемся на Лист 1 за следующей суммой критериев:
Next CurRec
End Sub

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 15:01

[ТС]

ArtNord, вам спасибо за помощь!!! на самом деле в этой таблице более 50000 строк и она с каждым днем становится больше. Макрос будет работать на все эти строки?

ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 15:01

Visual Basic

Next CurRec
'Здесь можно добавить вывод сообщения об окончании работы макроса:
msgbox("Готово!")
End Sub

Да, вот эта строчка как раз и опреляет сколько сейчас записей:

Visual Basic

1	cAllRecs = Application.WorksheetFunction.CountA(Sheets("2").Range("B:B"))

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 15:04

[ТС]

ArtNord, а если копировать нужно не на лист 2 а на другой лист который находится в другой книге, что нужно сделать?

ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 15:06

Если книга эта открыта то:

Visual Basic

1	Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11)

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 15:12

[ТС]

простите меня я такой овощь в этом деле, я не пойму куда мне нужно эту строчку вставить?

ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 15:15

Где присваиваете значения:
В каждой строке вида:

Visual Basic

1	Sheets("2").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11)

Заменить на:

Visual Basic

1	Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11)

Добавлено через 1 минуту

Visual Basic

Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 27) = Sheets("1").Cells(CurRec, 11) 
Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 17) = Sheets("1").Cells(CurRec, 12)
Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 18) = Sheets("1").Cells(CurRec, 13)
Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 30) = Sheets("1").Cells(CurRec, 27)
Workbooks("Название книги.xls").Sheets("Название листа").Cells(cRecs, 28) = Sheets("1").Cells(CurRec, 6)

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 15:16

[ТС]

ArtNord, Вы просто супер!!!! Я если честно даже не ожидал, что мне так сразу тут помогут!!! Дай вам бог здоровья!!!

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

31.05.2019, 15:17

Спасибо! Взаимно! Просто коротаю время до конца рабочего дня ))))

0 / 0 / 0

Регистрация: 02.12.2018

Сообщений: 99

31.05.2019, 15:23

[ТС]

ArtNord, нет не просто коротаете, вы людям помогаете!!!! Еще раз огромное спасибо ВАМ!!!!

Добавлено через 4 минуты
ArtNord, вы не подскажете, можно самому так научиться макросы писать, если да то где?

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	31.05.2019, 15:23
20

Источник

Возможности макросов в Excel практически неограниченные. В данном примере покажем в пару кликов можно создать любое количество копий листов используя VBA-макрос.

Как макросом скопировать листы в Excel

Допустим необходимо приготовить планы работ для сотрудников вашего отдела. Иметься шаблон таблицы для заполнения документа плана в виде одного рабочего листа Excel:

Но вам необходимо создать 12 планов и соответственно 12 листов. В программе Excel нет встроенного инструмента для многократного создания копий рабочих листов за одну операцию. А копировать и вставлять 12 (а в практике встречаются случаи что и 120) листов вручную, да еще их все нужно переименовать – это потребует много рабочего времени и пользовательских сил. Определенно лучше в таком случае воспользоваться собственным макросом. А чтобы его написать воспользуйтесь VBA-кодом, который будет представлен ниже в данной статье.

Сначала откройте редактор макросов Visual Basic:

Создайте в нем стандартный модуль с помощью опций меню: «Insert»-«Module» и введите в него этот код, который ниже представленный на листинге:

Sub CopyList() Dim kolvo As Variant Dim i As Long Dim list As Worksheet kolvo = InputBox("Укажите необходимое количество копий для данного листа") If kolvo = "" Then Exit Sub If IsNumeric(kolvo) Then kolvo = Fix(kolvo) Set list = ActiveSheet For i = 1 To kolvo list.Copy after:=ActiveSheet ActiveSheet.Name = list.Name & i Next Else MsgBox "Неправильно указано количество" End If End Sub

Теперь если нам нужно скопировать 12 (или любое другое количество) раз листов содержащие шаблон для заполнения плана работы сотрудника, кликните по исходному листу, чтобы сделать его активным и выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«CopyList»-«Выполнить». Сразу после запуска макроса появиться диалоговое окно, в котором следует указать количество копий листа:

Введите, например, число 12 и нажмите ОК:

Лист с шаблоном плана скопируется 12 раз, а все названия листов будут иметь такое же как название исходного листа только со своим порядковым номером от 1 до12.

Внимание! Если название исходного листа слишком длинное, тогда может возникнуть ошибка в процессе выполнения макроса. Ведь в Excel название листа не может содержать более чем 31 символ. То есть ориентируйтесь так чтобы название исходного листа было меньше чем 27 символов. Так же ошибка может возникнуть если текущая рабочая книга Excel уже содержит листы с таким названием как у копий. Ведь в Excel все листы должны иметь уникальные названия.

Примечание. В новых версиях Excel (начиная от 2010 версии) одна рабочая книга может содержать максимальное количество листов, которое ограничивается лишь размером свободной оперативной памяти системы.

Описание кода макроса для копирования листов Excel

В коде используются 3 переменные:

kolvo – в этой переменной определено какое количество копий будет создано при копировании текущего рабочего листа Excel.
i – счетчик циклов.
list – в этой переменной будет создан экземпляр объекта листа Excel.

В начале макроса вызываем диалоговое окно, в котором пользователь должен указать в поле ввода какое количество копий листов необходимо создать с помощью данного макроса «CopyList». Введенное числовое значение в поле ввода из этого диалогового окна передается в переменную kolvo. Если поле ввода пустое или в диалоговом окне была нажата кнопка отмены «Cancel», тогда дальнейшие инструкции не выполняться и работа макроса прерывается.

В следующей строке кода проверяется: является ли введенное значение в поле ввода – числовым? Если да, тогда на всякий случай удаляются все числа после запятой с помощью функции Fix.

Далее в переменой list создается экземпляр объекта ActiveSheet. После в цикле копируются листы. Количество циклов выполняется ровно столько, сколько пользователь указал в диалоговом окне макроса. В процессе копирования каждый раз изменяется название для новой копии листа. Так как в одной книге не может быть 2 и более листов с одинаковым названием. Уникальные названия для каждой копии создаются за счет присвоения к названию исходного листа число с порядковым номером текущего цикла. При необходимости пользователь может задать свои параметры для присвоения названия копиям листов изменив данную строку кода. Главное придерживаться правила уникальности названий листов.

Примечание. Если нет необходимости настраивать названия для новых листов, тогда данную строку кода можно закомментировать.

‘ActiveSheet.Name = list.Name & i

Читайте также: Макрос для переименования листов Excel при копировании.

В таком случае названия для копий Excel будет присваивать сам. Например, для исходного листа с названием «Лист1» копии будут получать названия: «Лист1 (2)», «Лист1 (3)», «Лист1 (4)» и т.д.

В конце кода выводиться сообщение на тот случай если пользователь неправильно указал числовое значение в поле ввода диалогового окна макроса.

Источник

Макрос копирования данных с разных листов на один лист

Nat

Дата: Четверг, 29.08.2013, 22:31 |
Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Добрый день!

Мне потребовалось написать макрос, но с ними я совсем не дружу, поэтому надеюсь на Вашу помощь. Нужно скопировать данные с разных листов на итоговый лист одной и той же книги Excel. Количество столбцов всегда одинаковое, а вот количество строк и листов — разное. При этом желательно, чтобы первую страницу он копировал с заголовком, а остальные — без. Файл прилагаю.

P.S. Пункт 5q в правилах форума я не нашла, поэтому заранее извиняюсь, если опять сделала что-то не так.

К сообщению приложен файл:

3838011.xls
(62.5 Kb)

Ответить

Hugo

Дата: Пятница, 30.08.2013, 00:25 |
Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3140

Репутация:
670
±

Замечаний:
0% ±

2010, теперь уже с PQ

Как это не нашли?
Вот он, под спойлером:
q — задавать новые вопросы в уже созданных чужих или своих темах

excel@nxt.ru
webmoney: R418926282008 Z422237915069

Ответить

Hugo

Дата: Пятница, 30.08.2013, 01:17 |
Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3140

Репутация:
670
±

Замечаний:
0% ±

2010, теперь уже с PQ

[vba]

Код

Option Explicit

Sub CopyData()
Dim sh As Worksheet, r As Range, i&
Application.ScreenUpdating = False

       Set sh = Worksheets.Add(before:=Worksheets(1))
       Set r = Worksheets(2).Columns(1).Find(1, , xlValues, xlWhole)
       If Not r Is Nothing Then
           r.Offset(-2).EntireRow.Resize(3).Copy sh.Cells(1)
           For i = 2 To Worksheets.Count
               With Worksheets(i)
                   Set r = .Columns(1).Find(1, , xlValues, xlWhole)
                   If Not r Is Nothing Then
                       .Range(r.Offset(1), .Range(«AJ» & .Rows.Count).End(xlUp)).Copy _
                     Worksheets(1).Range(«B» & .Rows.Count).End(xlUp)(2).Offset(, -1)
                   End If
               End With
           Next
       End If
       Application.ScreenUpdating = True
End Sub

[/vba]
Сперва искал по «Дата отправки КС» — но что-то на последнем листе не искалось (на том, который как пример собранного). Так и не понял, почему — переделал на поиск единицы

excel@nxt.ru
webmoney: R418926282008 Z422237915069

Ответить

SergeyKorotun

Дата: Пятница, 30.08.2013, 02:17 |
Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация:
15
±

Замечаний:
0% ±

Excel 2007

Опередили
[vba]

Код

Sub Start()
     Call CreateSheet
     Call Copy
End Sub
Private Sub CreateSheet()
    On Error Resume Next
    Set wsSheet = Sheets(«Итог»)
    If Err.Number = 0 Then
       Application.DisplayAlerts = False
       Sheets(«Итог»).Delete
       Application.DisplayAlerts = True
    End If
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = «Итог»
End Sub
Private Sub Copy()
  Dim sRng As Range
  Dim dRng As Range
     Application.ScreenUpdating = False
     ThisWorkbook.Sheets(1).Activate
     Set sRng = Range(«A9:AJ11»)
     ThisWorkbook.Sheets(Sheets.Count).Activate
     Set dRng = Range(«A1»)
     sRng.Copy dRng
     For i = 1 To ThisWorkbook.Sheets.Count — 1
        ThisWorkbook.Sheets(i).Activate
        Set sRng = Range(Cells(12, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        ThisWorkbook.Sheets(Sheets.Count).Activate
        Set dRng = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        sRng.Copy dRng
     Next i
     Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл:

qwerty_.xlsm
(32.0 Kb)

Ответить

Nat

Дата: Пятница, 30.08.2013, 15:09 |
Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Благодарю за помощь! Первый вариант рабочий. Во втором макрос копировал в исходную книгу (удалила «ThisWorkbook» в тексте — стал копировать в новый документ, хотя не уверена что именно это н.б. сделать) и только первые два листа (как это исправить — не знаю, да это уже и не так важно)…Полезная это вещь — макросы! Надо будет освоить хотя бы азы. Еще раз спасибо за помощь!

Ответить

SergeyKorotun

Дата: Пятница, 30.08.2013, 15:27 |
Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация:
15
±

Замечаний:
0% ±

Excel 2007

Nat, ThisWorkbook — это книга с которой вы запускаете макрос. По всей видимости вы вставили макрос не в ту книгу.
[vba]

Код

For i = 1 To ThisWorkbook.Sheets.Count — 1

[/vba] с первого листа по предпоследний.
Копирует только с двух наверно по той самой причине: не в ту книгу вставили макрос.
Скачайте qwerty_.xlsm, добавьте туда листов и запустите макрос и вы увидите что макрос обработает все листы.
В варианте Hugo в итоговом листе при повторных запусках строки будут дублироваться.

Ответить

Nat

Дата: Пятница, 30.08.2013, 15:52 |
Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Да, с дублированием в варианте Hugo я уже столкнулась.
Последовала вашему совету и поновой запустила макрос — действительно все ок. Спасибо!

Ответить

Hugo

Дата: Пятница, 30.08.2013, 17:30 |
Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3140

Репутация:
670
±

Замечаний:
0% ±

2010, теперь уже с PQ

Не запускайте повторно — не будет дублироваться
Если есть такая мания — нужно всего лишь добавить в код удаление первого листа. Если он тот, который лишний. Ну в общем этот вопрос не вопрос.
Зато у меня таблицы могут скакать по листу, и не скопируется лишнее, как в случае
[vba]

Код

Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

[/vba]Тут может и недокопироваться, и лишнее скопироваться — зависит от файла. Но если файлы всегда будут именно такие и никто туда руки не сунет — тогда ладно

excel@nxt.ru
webmoney: R418926282008 Z422237915069

Ответить

exelskatyazhelyi

Дата: Воскресенье, 19.02.2017, 08:53 |
Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Hugo, привет, всем Гуру экселя. Не могу разобраться с макросом, совсем вот уже 3 день. Нужно собрать данные со всех листов в один, листов больше 100 штук, постоянно дополняется. Кол-во столбцов одинаковое, строк-разное. может кто сможет помочь?

Ответить

Pelena

Дата: Воскресенье, 19.02.2017, 09:13 |
Сообщение № 10

Группа: Админы

Ранг: Местный житель

Сообщений: 18797

Репутация:
4284
±

Замечаний:
±

Excel 2016 & Mac Excel

exelskatyazhelyi, прочитайте Правила форума и создайте свою тему.
Эта тема закрыта

«Черт возьми, Холмс! Но как??!!»
Ю-money 41001765434816

Ответить

Источник

Условие задачи по копированию данных

Решение копированием с листа на лист

Решение с использованием массивов

Макрос для копирования информации с одного листа на другой по определенным условиям

Решение

Как макросом скопировать листы в Excel

Описание кода макроса для копирования листов Excel

А вот еще интересные статьи: