Копирование данных в таблице

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Копирование данных в таблице (Формулы/Formulas)

Chelovekov

Дата: Пятница, 05.05.2023, 00:59 | Сообщение № 1

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

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

Сообщений: 315

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

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

Excel 2016

Здравствуйте, Уважаемые Форумчане. Прошу, Вас помочь, решить проблему. Нужно написать макрос или формулу, если это возможно, которая будет выделять область для копирования, и ее копировать для дальнейшего использования, критерием для выделения области будет служить выбранная дата. То есть, согласно дате нужно выделить и скопировать, все ячейки, которые стоят справа от даты, вместе с датой.
Пример прилагаю
Заранее благодарен.

К сообщению приложен файл: 4784990.xlsx (14.0 Kb)

Ответить

elovkov

Дата: Пятница, 05.05.2023, 09:59 | Сообщение № 2

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

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

Сообщений: 411

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

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

Excel 2013

можно так, минус - в итоговой таблице заранее должно хватать строк

К сообщению приложен файл: 1209023.xlsx (12.7 Kb)

Умное лицо это еще не признак ума. Все глупости на земле делаются именно с этим выражением лица

Ответить

Chelovekov

Дата: Пятница, 05.05.2023, 14:15 | Сообщение № 3

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

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

Сообщений: 315

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

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

Excel 2016

Спасибо огромное, но если у кого будет варианты с макросом, очень будет не плохо.
hands

Ответить

Serge_007

Дата: Пятница, 05.05.2023, 14:53 | Сообщение № 4

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

[vba]

Код

Sub Chelovekov()
    Dim LR1&, LR2&, rR As Range
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                Range("j" & LR2) = CDate(rR)
                Range("k" & LR2) = rR.Offset(0, 1)
                Range("l" & LR2) = rR.Offset(0, 2)
            End If
        Next rR
End Sub

[/vba]

К сообщению приложен файл: 20230505_chelovekov.xls (38.0 Kb)

ЮMoney:41001419691823 | WMR:126292472390

Ответить

cmivadwot

Дата: Суббота, 06.05.2023, 03:02 | Сообщение № 5

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

Ранг: Ветеран

Сообщений: 534

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

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

365

Chelovekov, не совсем то, но....

К сообщению приложен файл: 5505192.xlsx (225.1 Kb)

Ответить

Chelovekov

Дата: Понедельник, 08.05.2023, 12:50 | Сообщение № 6

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

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

Сообщений: 315

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

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

Excel 2016

Спасибо огромное ребята hands

Ответить

Chelovekov

Дата: Среда, 17.05.2023, 15:55 | Сообщение № 7

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

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

Сообщений: 315

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

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

Excel 2016

Уважаемые Форумчане, могли бы Вы подредактировать данный макрос, с условием что нужно копировать и вставить данные, не в активный лист, а в другой лист. Имя листа Лист2. А так же после последующего копирование, таблица куда копируется данные очищалось от старых данных.
Пример прилагаю.
Заранее благодарен.

[vba]

Код

Sub Chelovekov()
Dim LR1&, LR2&, rR As Range
LR1 = Cells(Rows.Count, "a").End(xlUp).Row
For Each rR In Range("a1:a" & LR1)
LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
If rR = [e2] Then
Range("j" & LR2) = CDate(rR)
Range("k" & LR2) = rR.Offset(0, 1)
Range("l" & LR2) = rR.Offset(0, 2)
End If
Next rR
End Sub

[/vba]

К сообщению приложен файл: primer_kopir.xls (38.5 Kb)

Сообщение отредактировал Chelovekov - Среда, 17.05.2023, 15:56

Ответить

Serge_007

Дата: Среда, 17.05.2023, 16:26 | Сообщение № 8

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

[vba]

Код

Sub Chelovekov2()
    Dim LR1&, LR2&, LR3&, rR As Range
    LR3 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row
    Sheets("Лист2").Range("j2:l" & LR3).ClearContents
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                With Sheets("Лист2")
                .Range("j" & LR2) = CDate(rR)
                .Range("k" & LR2) = rR.Offset(0, 1)
                .Range("l" & LR2) = rR.Offset(0, 2)
                End With
            End If
        Next
End Sub

[/vba]