Страницы: 1
RSS
Макрос копирования строки из одного файла в другой
 
Здравствуйте! Помогите мне пожалуйста написать макрос:  
 
Есть 2 Файла ("Книга1" и "Книга2")  
в файле Книга1 столбец "В"- дата, нужно, чтобы в файл Книга2 копировались все строки с Книги1,при условии того, что в столбце "В" дата стоит позднее 3х месяцев от сегодняшнего дня, и при возможность, скопированную строчку в Книге1 окрашивать в какой нибудь цвет.  
ниже прикреплен файлы, прошу помочь мне.    
Заранее благодарю.
 
Для начала вот ссылка на тему:  
http://www.planetaexcel.ru/forum.php?thread_id=22596  
 
Там похожая задача, только копирование не между книгами, а между листами.  
Точнее завтра могу Вашу задачу посмотреть...
 
{quote}{login=Hugo}{date=16.01.2011 01:28}{thema=}{post}Для начала вот ссылка на тему:  
http://www.planetaexcel.ru/forum.php?thread_id=22596  
 
Там похожая задача, только копирование не между книгами, а между листами.  
Точнее завтра могу Вашу задачу посмотреть...{/post}{/quote}  
 
спасибо большое, буду признателен.
 
Сначала применяете автофильтр к вашим строкам, а потом используете эту надстройку:  
http://excelvba.ru/CopyRowsAddin
 
{quote}{login=EducatedFool}{date=16.01.2011 11:24}{thema=}{post}Сначала применяете автофильтр к вашим строкам, а потом используете эту надстройку:  
http://excelvba.ru/CopyRowsAddin{/post}{/quote}  
 
 
а можно сделать так, чтобы все происходило автоматический?  
 
и еще вопрос, можно ли написать макрос, который искал в столбце ячейку окрашенную в красный цвет, и копировал бы строку где находится данная ячейка в другую книгу.  
 
Помогите пожалуйста.
 
{quote}{login=Hugo}{date=16.01.2011 01:28}{thema=}{post}Для начала вот ссылка на тему:  
http://www.planetaexcel.ru/forum.php?thread_id=22596  
{/post}{/quote}  
 
а можно сделать так, чтобы строки копировал в уже существующий Лист2 ?
 
Можно сделать всё.  
Только Вы определитесь, что Вам нужно. Я тут уже начал первую задачу делать - теперь оказывается ещё две другие появились, все различные, хоть и похожи.  
Так что в итоге копировать нужно и куда?
 
{quote}{login=Hugo}{date=16.01.2011 01:48}{thema=}{post}Можно сделать всё.  
Только Вы определитесь, что Вам нужно. Я тут уже начал первую задачу делать - теперь оказывается ещё две другие появились, все различные, хоть и похожи.  
Так что в итоге копировать нужно и куда?{/post}{/quote}  
 
Спасибо большое. В идеале нужно первая задача. Помогите.
 
Например так.  
Вот только я не знаю, как определить срок в 3 месяца, может кто поопытнее подскажет. Я сделал тупо 33 дня:  
           If cc < Now - 33 Then  
Если уж очень важно именно 3 месяца, то это нужно подправить.  
Можно вероятно делать через DateDiff(), но сходу не получилось - разницу в месяцах считает, но нужно ещё и разницу в днях учитывать...
 
:) какие 33???  
Исправьте на If cc < Now - 92 Then  
Если попадётся посередине февраль - будет небольшой сдвиг, а так в среднем должно подойти...
 
{quote}{login=Hugo}{date=16.01.2011 05:37}{thema=}{post}:) какие 33???  
Исправьте на If cc < Now - 92 Then  
Если попадётся посередине февраль - будет небольшой сдвиг, а так в среднем должно подойти...{/post}{/quote}  
 
Спасибо большое Hugo выручили!  
Сейчас буду разбираться с кодом )))
 
Hugo  
Спасибо, то что нужно!  
 
можно еще один вопрос, что нужно прописать, чтобы строки с Книга1 копировались в 4 или 5 строку Книги2, тем самым оставляли шапку неизменной.
 
{quote}{login=recit}{date=16.01.2011 06:18}{thema=}{post}Hugo  
Спасибо, то что нужно!  
 
можно еще один вопрос, что нужно прописать, чтобы строки с Книга1 копировались в 4 или 5 строку Книги2, тем самым оставляли шапку неизменной.{/post}{/quote}  
Если нужно копировать в 4-ю строку - запишите данные в 3-ю в столбце B.  
Т.е. в коде ничего менять не нужно, нужно занести во 2-й столбец данные, ниже которых будут помещаться копируемые данные.  
Это определяется в строке:  
       iLastrow = .Sheets(1).Range("B" & Rows.Count).End(IIf(Len(.Sheets(1).Range("B" & Rows.Count)), xlDown, xlUp)).Row  
 
Да, я забыл выше пояснить - копируемые строки красятся, а перед копированием анализируется окраска даты - если она красная (т.е. уже копировалась), то копирование не происходит. Так исключается повторное копирование.
 
{quote}{login=Hugo}{date=16.01.2011 06:33}{thema=Re: }{post}{quote}{login=recit}{date=16.01.2011 06:18}{thema=}{post}Hugo  
Спасибо, то что нужно!  
 
можно еще один вопрос, что нужно прописать, чтобы строки с Книга1 копировались в 4 или 5 строку Книги2, тем самым оставляли шапку неизменной.{/post}{/quote}  
Если нужно копировать в 4-ю строку - запишите данные в 3-ю в столбце B.  
Т.е. в коде ничего менять не нужно, нужно занести во 2-й столбец данные, ниже которых будут помещаться копируемые данные.  
Это определяется в строке:  
       iLastrow = .Sheets(1).Range("B" & Rows.Count).End(IIf(Len(.Sheets(1).Range("B" & Rows.Count)), xlDown, xlUp)).Row  
 
Да, я забыл выше пояснить - копируемые строки красятся, а перед копированием анализируется окраска даты - если она красная (т.е. уже копировалась), то копирование не происходит. Так исключается повторное копирование.{/post}{/quote}  
 
 
Все получилось. Очень признателен Вам!!! Спасибо ;)
 
А можно добавить еще одно условие, т.е двойное условие:  
Допустим, чтобы виз книги1 в книгу2 копировалась строка с датой (столбец В) позднее 92 дней и статусом (столбец Е) - "В работе".
 
Легко, тем более что по первой ссылке такое условие в коде есть - можно сделать по образцу:  
 
       For Each cc In ra  
           If cc < Now - 92 Then  
               If InStr(cc.Offset(, 3), "работе") > 0 Then  
                   If ws.Cells(cc.Row, 2).Font.ColorIndex <> 3 Then  
                       iLastrow = iLastrow + 1  
                       ws.Rows(cc.Row).Copy .Sheets(1).Cells(iLastrow, 1)  
                       ws.Rows(cc.Row).Font.ColorIndex = 3  
                   End If  
               End If  
           End If  
       Next  
 
Тут добавлено одно условие, т.е. две строки. Нужно выложить в файле, или сами исправите код?
 
{quote}{login=Hugo}{date=16.01.2011 08:06}{thema=}{post}Легко, тем более что по первой ссылке такое условие в коде есть - можно сделать по образцу:  
 
       For Each cc In ra  
           If cc < Now - 92 Then  
               If InStr(cc.Offset(, 3), "работе") > 0 Then  
                   If ws.Cells(cc.Row, 2).Font.ColorIndex <> 3 Then  
                       iLastrow = iLastrow + 1  
                       ws.Rows(cc.Row).Copy .Sheets(1).Cells(iLastrow, 1)  
                       ws.Rows(cc.Row).Font.ColorIndex = 3  
                   End If  
               End If  
           End If  
       Next  
 
Тут добавлено одно условие, т.е. две строки. Нужно выложить в файле, или сами исправите код?{/post}{/quote}  
 
 
Попытался исправить, вроде получилось, но после копирования строка не окрашивается, в чем можетбыть проблема?
 
Еще один вопрос, если дата не проставлена, то строка все равно окрашивается, как это исправить?
 
По неокрашиванию - должна окрашиваться, не знаю, что сказать...  
По "нет даты" - да, упустил.  
Добавьте в начале цикла проверку "есть ли дата":  
If IsDate(cc) Then  
т.е.  
 
For Each cc In ra  
If IsDate(cc) Then  
If cc < Now - 92 Then  
If InStr(cc.Offset(, 3), "работе") > 0 Then  
If ws.Cells(cc.Row, 2).Font.ColorIndex <> 3 Then  
iLastrow = iLastrow + 1  
ws.Rows(cc.Row).Copy .Sheets(1).Cells(iLastrow, 1)  
ws.Rows(cc.Row).Font.ColorIndex = 3  
End If  
End If  
End If  
End If  
Next
 
{quote}{login=Hugo}{date=17.01.2011 09:18}{thema=}{post}По неокрашиванию - должна окрашиваться, не знаю, что сказать...  
По "нет даты" - да, упустил.  
Добавьте в начале цикла проверку "есть ли дата":  
If IsDate(cc) Then  
т.е.  
 
For Each cc In ra  
If IsDate(cc) Then  
If cc < Now - 92 Then  
If InStr(cc.Offset(, 3), "работе") > 0 Then  
If ws.Cells(cc.Row, 2).Font.ColorIndex <> 3 Then  
iLastrow = iLastrow + 1  
ws.Rows(cc.Row).Copy .Sheets(1).Cells(iLastrow, 1)  
ws.Rows(cc.Row).Font.ColorIndex = 3  
End If  
End If  
End If  
End If  
Next{/post}{/quote}  
 
все получилось! Спасибо.  
 
Подскажите, в строке If InStr(cc.Offset(, 3), "работе") > 0 Then  
cc.Offset(, 3) - это что?
 
Это сдвиг вправо на 3 позиции от проверяемой в цикле ячейки.  
Т.е. цикл по cc, и параллельно проверяем соседнюю ячейку (т.к. саму сс проверяем тоже)
 
{quote}{login=Hugo}{date=17.01.2011 11:43}{thema=}{post}Это сдвиг вправо на 3 позиции от проверяемой в цикле ячейки.  
Т.е. цикл по cc, и параллельно проверяем соседнюю ячейку (т.к. саму сс проверяем тоже){/post}{/quote}  
 
понятно...спасибо большое!
 
мальчики исправте пожалуста этот код чтобы он переносил данные по строчно из листа "ААААА" в лист"ВВВВВ" при условии наличия в столбце "V" даты  тоесть если в этой строке в ячейке столбца "V" есть дата, то из листа "ААААА" эта строка удаляется после того как туда внесли дату и вставляется в лист "ВВВВВ"  
 
 
For Each cc In ra  
If cc < Now - 92 Then  
If InStr(cc.Offset(, 3), "работе") > 0 Then  
If ws.Cells(cc.Row, 2).Font.ColorIndex <> 3 Then  
iLastrow = iLastrow + 1  
ws.Rows(cc.Row).Copy .Sheets(1).Cells(iLastrow, 1)  
ws.Rows(cc.Row).Font.ColorIndex = 3  
End If  
End If  
End If  
Next
 
вставляться должна в первую свободную сроку
 
Лиска, сделал модификацию предыдущего кода. Лишнее не удалял, а просто закомментировал - всё, что в коде зелёным - можно удалить.  
А может позже понадобится ещё какое-нибудь условие добавить - тогда их можно использовать.  
Строки переносятся не на второй лист, а в другой файл Книга 2.xls, который находится в папке с исходным файлом. Его нужно сперва создать.Но это несложно исправить.
 
{quote}{login=Hugo}{date=19.01.2011 11:13}{thema=}{post}Лиска, сделал модификацию предыдущего кода. Лишнее не удалял, а просто закомментировал - всё, что в коде зелёным - можно удалить.  
А может позже понадобится ещё какое-нибудь условие добавить - тогда их можно использовать.  
Строки переносятся не на второй лист, а в другой файл Книга 2.xls, который находится в папке с исходным файлом. Его нужно сперва создать.Но это несложно исправить.{/post}{/quote}  
 
спасибо большое! Но у меня проблемка когда я пыталась скопировать код из этого файла в свой при сохранении написало что форматы не подходят у меня 2007 стоит.
 
Не знаю, в коде вроде ничего нет, что под 2007 не работает...  
Может быть security не даёт, может быть надо макросы разрешить.  
Я сейчас всё равно версию под 2007 сделать не могу - нет его тут.
 
{quote}{login=Hugo}{date=20.01.2011 03:18}{thema=}{post}Не знаю, в коде вроде ничего нет, что под 2007 не работает...  
Может быть security не даёт, может быть надо макросы разрешить.  
Я сейчас всё равно версию под 2007 сделать не могу - нет его тут.{/post}{/quote}    
простите а как с вами поговорит в скайпе или Магенте? как ком нибудь?
 
Skype только вечером.  
Напишите на емайл из подписи, только "_" уберите - вечером постараюсь позвонить, я живу -1 по Москве (вдруг мы в противофазе :))
Страницы: 1
Читают тему
Наверх