Макрос для обьединения данных

@Александр Таран · Регистрация: 29.04.2018

Студворк — интернет-сервис помощи студентам

Проимер;
Данные находятся в колонках ABCDEFG и IJKLMNO. Необходимо обьединить эти данные на другом листе под ABCDEFG
Допустим есть 100 строк инфы под ABCDEFG и 200 строк инфы под IJKLMNO. Должно получиться на другом листе 300 строк инфы под ABCDEFG. С уважением А. Таран

@Александр Таран · 24.05.2019, 17:30 **[ТС]**

Есть строки с данными в ABCDEFG( число строк может меняться) и IJKLMNO(число строк может меняться) на одном листе.
Нужен макрос скопировать эти строки на другой лист под ABCDEFG. С уважением А Таран

@Narimanych · 24.05.2019, 19:09

Александр Таран,

Как вариант с листа 1 на лист 2...

Visual Basic

Sub For_Sasha ()
LR1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Sheets(1).Cells(Rows.Count, 9).End(xlUp).Row
 
With Sheets(1)
A = .Range(.Cells(1, 1), .Cells(LR1, 7))
B = .Range(.Cells(1, 9), .Cells(LR2, 15))
 
End With
 
With Sheets(2)
.Range("A1").Resize(LR1, 7) = A
.Cells(LR1 + 1, 1).Resize(LR2, 7) = B
End With
 
End Sub

@Александр Таран · 25.05.2019, 08:38 **[ТС]**

А почему так не работает? Выдает ошибку 400

Visual Basic

Sub For_Sasha()
LR1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Sheets(1).Cells(Rows.Count, 9).End(xlUp).Row
LR3 = Sheets(1).Cells(Rows.Count, 17).End(x1Up).Row
 
With Sheets(1)
A = .Range(.Cells(1, 1), .Cells(LR1, 7))
B = .Range(.Cells(1, 9), .Cells(LR2, 15))
C = .Range(.Cells(1, 17), .Cells(LR3, 23))
 
End With
 
With Sheets(2)
.Range("A1").Resize(LR1, 7) = A
.Cells(LR1 + 1, 1).Resize(LR2, 7) = B
.Cells(LR1 + 1, 1).Resize(LR3, 7) = C
End With
 
End Sub

@Narimanych · 25.05.2019, 10:02

Александр Таран,

вы файлик прикрепите....

Добавлено через 9 минут
и строчка 16:

Visual Basic

1	.Cells(LR1 + LR2 + 1, 1).Resize(LR3, 7) = C

@Александр Таран · 25.05.2019, 10:21 **[ТС]**

Narimanych
А Вы любые данные внесите в эти столбцы.
Любые данные в ABCDEFG, IJKLMNO, QRSTUVW и т.д.
1111101, 2222202, 3333303 и т.д.
Должно получится:
ABCDEFG
1111101
2222202
3333303
и т.д.
Александр Таран

@Narimanych · 25.05.2019, 10:25

Александр Таран,

Если я прошу прикрепить файл с ошибкой- значит проблема у вас в файле...

@Александр Таран · 25.05.2019, 10:39 **[ТС]**

Хорошо попробую выслать файл

Добавлено через 3 минуты
Выслал файл

Добавлено через 8 минут
НУ меня файл сохраняется под xlsm Видимо поэтому не могу выслать

shanemac51 · 25.05.2019, 10:42

Сообщение от Александр Таран

НУ меня файл сохраняется под xlsm Видимо поэтому не могу выслать

зазипуйте перед выкладыванием

@Александр Таран · 25.05.2019, 10:47 **[ТС]**

Пробую

@Александр Таран · 25.05.2019, 11:08 **[ТС]**

А как насчёт 4 и 9 строчек?

@Narimanych · 25.05.2019, 11:32

Александр Таран,
В вашем файле сотрите строку
LR3 = Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row

Создайте ее заново, скопировав
LR2 = Sheets(1).Cells(Rows.Count, 9).End(xlUp).Row

и еще:Вы не обратили внимание на

Сообщение от Narimanych

Александр Таран,
Как вариант с листа 1 на лист 2...

Поэтому для вашего случая код:

Проверьте и отпишитесь.

Visual Basic

Sub For_Sasha()
LR1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LR3 = Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row
 
With Sheets(2)
A = .Range(.Cells(1, 1), .Cells(LR1, 7))
B = .Range(.Cells(1, 9), .Cells(LR2, 15))
C = .Range(.Cells(1, 17), .Cells(LR3, 23))
 
End With
 
With Sheets(1)
.Range("A1").Resize(LR1, 7) = A
.Cells(LR1 + 1, 1).Resize(LR2, 7) = B
.Cells(LR1 + LR2 + 1, 1).Resize(LR3, 7) = C
End With
 
End Sub

@Александр Таран · 25.05.2019, 12:59 **[ТС]**

Narimanych,
Огромное спасибо. Разобрался.
Все работает

@Narimanych · 25.05.2019, 17:19

Александр Таран,

У вас в строке LR3 = Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row вместо XLUP было нвписано X1UP

@Александр Таран · 26.05.2019, 10:41 **[ТС]**

Narimanych,
С добавлением строки данных:

Visual Basic

Sub For_Sasha()
LR1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Sheets(1).Cells(Rows.Count, 9).End(xlUp).Row
LR3 = Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row
LR4 = Sheets(1).Cells(Rows.Count, 25).End(x1Up).Row
 
With Sheets(1)
A = .Range(.Cells(1, 1), .Cells(LR1, 7))
B = .Range(.Cells(1, 9), .Cells(LR2, 15))
C = .Range(.Cells(1, 17), .Cells(LR3, 23))
D = .Range(.Cells(1, 25), .Cells(LR4, 31))
End With
 
With Sheets(2)
.Range("A1").Resize(LR1, 7) = A
.Cells(LR1 + 1, 1).Resize(LR2, 7) = B
.Cells(LR1 + LR2 + 1, 1).Resize(LR3, 7) = C
.Cells(LR1 + LR2 + LR3 + 1, 1).Resize(LR4, 7) = D
End With
 
End Sub

Правильно или нет?

@Александр Таран · 27.05.2019, 16:03 **[ТС]**

Чет пропали все

@Александр Таран · 28.05.2019, 14:14 **[ТС]**

С 3 диапазонами работает отлично. С 4 выдает ошибку 400

Добавлено через 20 минут
Нашел в чем дело , тикает

@Narimanych · 28.05.2019, 14:56

Сообщение от Александр Таран

С 3 диапазонами работает отлично. С 4 выдает ошибку 400

Вы хоть посты читаете?

Прочтите пост 14 и посмотрите на свой код...

@Александр Таран · 28.05.2019, 20:14 **[ТС]**

Написал же ВСЁ ТИКАЕТ.

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	25.05.2019, 12:59 [ТС]	13
	Narimanych, Огромное спасибо. Разобрался. Все работает 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
		1
	Макрос для обьединения данных 24.05.2019, 17:21. Показов 899. Ответов 18 Метки нет (Все метки) Проимер; Данные находятся в колонках ABCDEFG и IJKLMNO. Необходимо обьединить эти данные на другом листе под ABCDEFG Допустим есть 100 строк инфы под ABCDEFG и 200 строк инфы под IJKLMNO. Должно получиться на другом листе 300 строк инфы под ABCDEFG. С уважением А. Таран 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	24.05.2019, 17:30 [ТС]	2
	Есть строки с данными в ABCDEFG( число строк может меняться) и IJKLMNO(число строк может меняться) на одном листе. Нужен макрос скопировать эти строки на другой лист под ABCDEFG. С уважением А Таран 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	25.05.2019, 10:21 [ТС]	6
	Narimanych А Вы любые данные внесите в эти столбцы. Любые данные в ABCDEFG, IJKLMNO, QRSTUVW и т.д. 1111101, 2222202, 3333303 и т.д. Должно получится: ABCDEFG 1111101 2222202 3333303 и т.д. Александр Таран 0

@Narimanych 2698 / 1683 / 768 Регистрация: 23.03.2015 Сообщений: 5,325
	25.05.2019, 10:25	7
	Александр Таран, Если я прошу прикрепить файл с ошибкой- значит проблема у вас в файле... 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	25.05.2019, 10:39 [ТС]	8
	Хорошо попробую выслать файл Добавлено через 3 минуты Выслал файл Добавлено через 8 минут НУ меня файл сохраняется под xlsm Видимо поэтому не могу выслать 0

shanemac51 Модератор 11534 / 4743 / 765 Регистрация: 07.08.2010 Сообщений: 13,794 Записей в блоге: 4
	25.05.2019, 10:42	9
	Сообщение от Александр Таран НУ меня файл сохраняется под xlsm Видимо поэтому не могу выслать зазипуйте перед выкладыванием 1

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	25.05.2019, 11:08 [ТС]	11
	А как насчёт 4 и 9 строчек? 0

@Narimanych 2698 / 1683 / 768 Регистрация: 23.03.2015 Сообщений: 5,325
	25.05.2019, 17:19	14
	Александр Таран, У вас в строке LR3 = Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row вместо XLUP было нвписано X1UP 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	27.05.2019, 16:03 [ТС]	16
	Чет пропали все 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	28.05.2019, 14:14 [ТС]	17
	С 3 диапазонами работает отлично. С 4 выдает ошибку 400 Добавлено через 20 минут Нашел в чем дело , тикает 0

	28.05.2019, 20:14

@Narimanych 2698 / 1683 / 768 Регистрация: 23.03.2015 Сообщений: 5,325
	28.05.2019, 14:56	18
	Сообщение от Александр Таран С 3 диапазонами работает отлично. С 4 выдает ошибку 400 Вы хоть посты читаете? Прочтите пост 14 и посмотрите на свой код... 0

@Александр Таран 0 / 0 / 0 Регистрация: 29.04.2018 Сообщений: 77
	28.05.2019, 20:14 [ТС]	19
	Написал же ВСЁ ТИКАЕТ. 0