Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Автоматическое копирование данных с одного листа книги на другой
 
#1
19.09.2012 10:22:24
Имеется книга с двумя листами. На одном листе ведётся ежедневный учёт рабочего времени, который заполняется в течение дня, а в конце должен копироваться на лист "Сводный учёт". Помогите пожалуйста автоматизировать процесс копирования. Понимаю, что без макроса здесь не обойтись, но я с ними практически не знаком, поэтому буду очень признателен за подробную помощь. Сложность в том, что в "Сводном учёте" должна содержаться информация за все дни, т.е. копирование должно делаться не в те же самые ячейки, а в следующие свободные.
 
 
 
#2
19.09.2012 10:38:29
И зачем Вам этот ежедневный учёт? Почему не писать сразу всё в базу?  
Скопировать легко:  
 
Sub tt()  
With Sheets(2)  
.Range(.[F2], .Range("B" & Rows.Count).End(xlUp)).Copy Sheets(1).[A1].End(xlDown)(2)
End With  
End Sub  
 
Только смтотрите, не запустите лишний раз!
 
 
 
#3
19.09.2012 10:54:50
HUGO,спасибо огромное, очень помогли, только есть одна проблема - если с листа "Сводный учёт" удалить все записи, то макрос выдаёт ошибку и не копирует.  
Ежедневный учёт нужен для облегчения ведения и наглядности, пробовали сразу вести сводный - забывают, вносят не всю информацию...
 
 
 
#4
19.09.2012 10:59:17
И ещё один вопрос, а если мне понадобится изменить диапазон копируемых данных (например копировать не все столбцы, а только C, D и E) какие изменения надо будет внести?
 
 
 
#5
19.09.2012 11:10:18
Да, чуть ошибся.  
Нужно так:  
 
Sub tt()  
With Sheets(2)  
.Range(.[F2], .Range("B" & Rows.Count).End(xlUp)).Copy Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With  
End Sub  
 
Для изменения диапазона меняйте тут:  
(.[F2], .Range("B"
 
 
 
#6
19.09.2012 11:17:50
И ещё раз большое спасибо, что уделили время. Возник ещё один вопрос, а можно сделать так, чтоб копировались только значения (т.е. без формата ячеек, формул и т.д.)? Извините, что не сразу полностью сформулировал вопрос.
 
 
 
#7
19.09.2012 11:44:13
Можно. Например через массив (хотя можно и спецвставкой):  
 
Sub tt()  
   Dim a()  
   With Sheets(2)  
       a = .Range(.[F2], .Range("B" & Rows.Count).End(xlUp)).Value
       Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a, 1), UBound(a, 2)) = a  
   End With  
End Sub
 
 
 
#8
19.09.2012 12:25:45
Всё работает, Вы очень мне помогли, спасибо!
 
 
 
#9
19.09.2012 13:34:37
Здрасте  
А проверочку можна вставить, чтобы одно и тоже в свод не попадало дважды.  
спасибо
 
 
 
#10
19.09.2012 13:41:54
Можно.  
Если Вы сформулируете, что такое "одно и тоже", конечно.  
Но заметьте - я не сказал, что сделаю.
 
 
 
#11
19.09.2012 14:10:41
Одно и тоже, означает те же даные без каких-либо изменений
 
 
 
#12
19.09.2012 14:19:10
Конкретнее - какие теже?  
Там например есть строка  
19.09.12 О.4 ВР 10  
Её как рассматривать?  
 
Пишите всё сразу на один лист - и будете спать спокойно :)  
Ну а просмотр за день - фильтром по дате.
 
 
 
#13
19.09.2012 14:29:43
Да у меня похожая,но совсем другая ситуация. Где надо именно так делать.  
А теже, значит полностью идентичные.  
А точнее, расчет на забывчивость или невнимательность юзера.  
Случайно нажал на кнопку и скопировал лишний раз один т тот же день.
 
 
 
#14
19.09.2012 14:36:13
Просто данные и ситуации бывают разные.  
Если "скопировал лишний раз один тот же день" - то можно взять день копируемых данных и сперва поискать его на сводном листе (как угодно, хоть find, хоть перебором массива снизу вверх для скорости).  
Если есть - отлуп.  
Тогда уже один день не скопируешь - но и не дополнишь.
 
 
 
#15
19.09.2012 14:56:05
извините,но для меня это сложная и нерешимая задачка  
благодарю вас за желание посмочь
 
 
 
#16
19.09.2012 15:16:30
Хорошо.  
Вот для примера выше - если даты всегда идут по порядку (анализируем только первую попавшуюся, если она не больше!)  
 
 
Sub tt()  
   Dim a(), b(), dta As Date, i&  
   With Sheets(2)  
       a = .Range(.[F2], .Range("B" & Rows.Count).End(xlUp)).Value
       With Sheets(1)  
           b = .Range(.[A2], .Range("A" & Rows.Count).End(xlUp)).Value
       End With  
       dta = a(1, 1)  
       'или  
       dta = a(UBound(a), 1)  
       For i = UBound(b) To 1 Step -1  
           If CDate(b(i, 1)) < dta Then Exit For  
           If CDate(b(i, 1)) = dta Then  
               MsgBox "Уже сделано...", vbCritical  
               Exit Sub  
           End If  
       Next  
       Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a, 1), UBound(a, 2)) = a  
   End With  
End Sub
 
 
 
#17
19.09.2012 15:32:41
Спасибо Hugo  
работает.  
А если бы еще была возможность продолжить копирование по согласию юзера. Как бы ексель предупреждает что такие даные уже есть и предлагает либо продолжить копирование либо отказаться. Кнопки ДА и НЕТ.  
БЫЛО БЫ ВЕЛИКОЛЕПНО  
извините за назойливость
 
 
 
#18
19.09.2012 16:10:31
Сделайте проще - не копируем, а переносим.  
Т.е. сперва копируем, затем скопированное стираем.  
Тогда и проверять не нужно, и спрашивать...  
Если забил повторно - сам дурак, или так нужно.
 
 
 
#19
19.09.2012 16:38:12
Нет, копируемое стирать никак нельзя. Оно нужно для работы в будущем
 
 
 
#20
19.09.2012 16:55:17
Такой вариант.  
Подумал - зачем там цикл поиска?  
Берём последнюю дату и сравниваем:  
 
Sub tt()  
   Dim a(), b As Date, dta As Date, i&  
   With Sheets(2)  
       a = .Range(.[F2], .Range("B" & Rows.Count).End(xlUp)).Value
       b = Sheets(1).Range("A" & Rows.Count).End(xlUp).Value  
 
       '        dta = a(1, 1)  
       'или  
       dta = a(UBound(a), 1)  
       If b >= dta Then  
           Select Case MsgBox("Уже сделано..." & vbNewLine & "Всё равно копировать?", vbYesNo Or vbExclamation Or vbDefaultButton2, Application.Name)  
               '                Case vbYes  
               '                    делаем что-то на YES  
           Case vbNo  
               Exit Sub  
           End Select  
       End If  
       Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a, 1), UBound(a, 2)) = a  
   End With  
End Sub
 
 
 
#21
19.09.2012 17:28:11
Hugo и это здорово у вас получилось!  
Спасибо
 
 
 
Страницы: 1
Читают тему
Наверх