Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание архива данных на другом листе с датой временем и именем пользователя
 
#1
31.05.2020 17:09:11
Доброго времени суток!
Прошу помочь в разрешении проблемы. Дан лист GeMS где в ячейках А и B пополняются данные, с ними производятся манипуляции анализа.После чего данные удаляются. Необходим макрос который бы после манипуляций копировал(Через кнопку) в лист LOG данные ячеек А и В, а в ячейки C, D, E проставлял имя пользователя, дату, время соответственно. Количество данных постоянно меняется но не превышает 100 строк.
Изменено: foxster_72 - 31.05.2020 17:10:52
 
 
 
#2
31.05.2020 21:12:59
foxster_72, не очень понятно что конкретно хотите ..возможно так. старые данные стираются
Код
Sub copy_AB()
Dim lr As Long
Dim rng As Range
Dim sh As Worksheet
Set sh = Worksheets("LOG")
sh.Range("C:E").Clear
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range(Cells(1, 1), Cells(lr, 2))
sh.Range("c1") = Application.UserName & " " & Now
rng.Copy Destination:=sh.Range("d1")
End Sub
Изменено: Mershik - 31.05.2020 21:16:16
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
01.06.2020 07:46:59
Mershik, Согласен, несколько неправильно поставил задачу. Копируются данные начиная  со второй строки ( (A2:A100);(B2:B100) в листе GeMS. После копирования в листе GeMS необходимо удалить данные  (A2:A100);(B2:B100). То есть в листе LOG должны накапливаться скопированные данные, но количество их постоянно меняется. То есть количество строк с данными 10, копируем в лист LOG, удаляем в листе GeMS (A2:A100);(B2:B100), новое количество данных 5, перебираем строки в листе LOG пока не найдём пустую( в данном случае 11 строку т.к у нас уже есть 10 скопированных)/
 
 
 
#4
01.06.2020 08:26:23
foxster_72, в модуль листа 1
Код
Dim lr As Long
Dim rng As Range
Dim sh As Worksheet
Set sh = Worksheets("LOG")
lr = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh.Cells(Rows.Count, 5).End(xlUp).Row
Set rng = Range(Cells(2, 1), Cells(lr, 2))
sh.Range("c" & lr2 + 1) = Application.UserName & " " & Now
rng.Copy Destination:=sh.Range("d" & lr2 + 1)
Range(Cells(2, 1), Cells(lr, 2)).ClearContents
End Sub
Изменено: Mershik - 01.06.2020 08:44:31
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
01.06.2020 08:49:04
Mershik,Спасибо вам за проделанную работу. Всё работает. 2 часа экономии времени.
 
 
 
Страницы: 1
Наверх