Sub probeg()  
MyPath = ThisWorkbook.Path  
MyName = ThisWorkbook.Name  
Set aaa = ThisWorkbook  
With Application  
   .ScreenUpdating = False 'обновление экрана  
   .DisplayAlerts = False 'выод системных сообщений  
   .Calculation = xlManual 'автопересчет формул  
 
   xxx = Dir(MyPath + "\*.xls")  
   t1 = Time  
   i = 3  
   k = 1  
   UserForm1.Show  
   'Dim yyy(7) As String  
   Do While Len(xxx) > 0  
       If xxx <> MyName Then 'And Right(xxx, 3) = "xls" 'Then  
           On Error GoTo l1  
           Workbooks.Open Filename:=MyPath + "\" + xxx, ReadOnly:=True  
           GoTo l2  
l1:  
           On Error GoTo l3  
           Workbooks.Open Filename:=MyPath + "\" + xxx, ReadOnly:=True, UpdateLinks:=False, CorruptLoad:=xlRepairFile  
l2:  
           i = i + 1  
           aaa.Sheets(1).Cells(i, 1) = ActiveWorkbook.Sheets("1").Cells(5, 136).Text  
           aaa.Sheets(1).Cells(i, 2) = ActiveWorkbook.Sheets("1").Cells(1, 136).Text  
           aaa.Sheets(1).Cells(i, 3) = ActiveWorkbook.Sheets("1").Cells(23, 121).Text  
           aaa.Sheets(1).Cells(i, 4) = ActiveWorkbook.Sheets("1").Cells(25, 121).Text  
           aaa.Sheets(1).Cells(i, 5) = ActiveWorkbook.Sheets("1").Cells(9, 136).Text  
           aaa.Sheets(1).Cells(i, 6) = ActiveWorkbook.Sheets("1").Cells(27, 121).Text  
           aaa.Sheets(1).Cells(i, 7) = ActiveWorkbook.Sheets("1").Cells(48, 170).Text  
           ActiveWorkbook.Close False  
           'Cells(i, 1) = yyy(1)  
           'Cells(i, 2) = yyy(2)  
           'Cells(i, 3) = yyy(3)  
           'Cells(i, 4) = yyy(4)  
           'Cells(i, 5) = yyy(5)  
           'Cells(i, 6) = yyy(6)  
           'Cells(i, 7) = yyy(7)  
             
           UserForm1.l1.Caption = xxx  
           UserForm1.Repaint  
           k = k - 1  
l3:  
       End If  
       xxx = Dir  
   Loop  
   UserForm1.Hide  
   .ScreenUpdating = True 'обновление экрана  
   .DisplayAlerts = True 'выод системных сообщений  
   .Calculation = xlAutomatic 'автопересчет формул  
End With  
t1 = Time - t1  
Cells(1, 3) = t1  
End Sub  
 
тут добавлена проверка файла на ошибки, у меня в 7 версии иногда перед открытием появляется запрос на восстановление файла, если он с ошибкой записан был

Уже близок к решению, скоро причешу все и выложу... Терзают смутные сомненья, что с тысячей отрабатываемых файлов придется оставить комп на все выходные с запущенным макросом, но он и создаст мне тот реестр, который в дальнейшем поможет поменять идеологию

Татьяна, ближайшее время покопаюсь с предложенным вариантом и применим к Вашей конкретной ситуации

Наверно надо создать файл, ну пусть «список.xls» проверив нет ли такого файла в этой папке, потом открыть первый файл текущей папки и скопировать в А4 данные из EF5, в B4 из EF1 и т.д. по нескольким ячейкам, потом закрыть  файл из которого скопирована информация и открыть следующий, повторить процедуры копирования в следующую строку  и так перебрать  все файлы… Своим умом смогу создать файл и копирование инфы из ячейки в ячейку, но завязну на том как задать отрыть следующий файл не указывая имени и копировать из него уже в следующую строку создаваемого файла… а маросы у меня только макрорекордером получаются… иногда :(

а здесь то что надо получить

Требуется создать макрос который бы сформировал в текущей папке файл, скопировав туда информацию из определенных ячеек всех содержащихся в этой папке файлов, т.е. в 1 строку из 1 файла, во 2 из второго, и так из всех файлов. Имеющиеся файлы имеют атрибут "только для чтения". Файлов много, потому и хочется макросом. Пример имеющегося файла

хм... А еще, неповерите, тормозилось потому что после имени листа на ярлычке пробел не виден, а там он был, а в тексте макроса в имени листа его(пробела) небыло... Ошибся когда листы переименовывал

Dophin!!! Где Вы? :(  
на этой строке все встает    
ThisWorkbook.Sheets(Array("ДОПЛ 09", "ДОПЛ РАБ 09", "свои ПФ 2010", "свои ОМС 2010", "РАБ ОПС")).Copy after:=Workbooks(k).Sheets(5) 'копируем пачку листов в открытую книгу    
дело видимо в том, что в тех книгах (куда я копирую листы) количество листов бывает разное....

вот, выкинул все ненужное

свалил бронхит... Вышел на работу, модуль с макросом ввел в 2007 excel, сохранил в формате xlsm, переименовал требуемые к переносу листы и макрос перестал работать  
 
Sub переносЛистов()  
     
   Application.ScreenUpdating = False  
   Dim sh As Worksheet, k As String  
   ks = Application.GetOpenFilename(filefilter:="Excel(*.xlsx), *.xlsx,")  
   k = Right(ks, Len(ks) - InStrRev(ks, "\"))  
   Workbooks.Open (ks)    ' открываем файл  из той же папки где лежит файл с макросом, можно указать свою  
   ' например "C:\temp\Proba.xls"  
   Workbooks(k).Sheets("1").Unprotect Password:="1604" 'снял защиту с листа и вношу в ячейки следующие изменения  
   Workbooks(k).Sheets("1").Range("dp1") = "Прил. №1 к Приказу Минфина РФ от 08.12.2008 №137н (в ред. от 19.11.2009.№119н)"  
   Workbooks(k).Sheets("1").Range("dj12") = 1  
   Workbooks(k).Sheets("1").Range("dm12") = 0  
   Workbooks(k).Sheets("1").Range("ef35") = 1.295  
   Workbooks(k).Sheets("1").Protect Password:="1604"  
Workbooks(k).Sheets("4_3").Unprotect Password:="1604"  
Workbooks(k).Sheets("4_3").Range("a19") = "Сумма страховых взносов на обязательное пенсионное страхование, обязательное социальное страхование на случай временной нетрудоспособности и в связи с материнством, обязательное медицинское страхование, обязательное социальное страхование от несчастных случаев на производстве и профессиональных заболеваний, уплаченных (в пределах исчисленных сумм) за налоговый период в соответствии с законодательством Российской Федерации при выплате налогоплательщиками вознаграждений работникам, занятым в тех сферах деятельности налогоплательщика, по которым уплачивается единый налог, а также сумма страховых взносов в виде фиксированных платежей, уплаченных индивидуальными предпринимателями за свое страхование"  
Rows("21:21").RowHeight = 88 'А19 мала для этого текста, (формат изменяемой ячейки объединение перенос по словам), здесья пытаюсь её раздвинуть (нижняя граница строка 22)  
Workbooks(k).Sheets("4_3").Protect Password:="1604"  
   ThisWorkbook.Sheets(Array("ДОПЛ 09", "ДОПЛ РАБ 09", "свои ПФ 2010", "свои ОМС 2010", "РАБ ОПС")).Copy after:=Workbooks(k).Sheets(5)     'копируем пачку листов в открытую книгу  
   For Each sh In Workbooks(k).Sheets  
       'рвем на каждом листе связь с прошлым файлом  
       sh.Cells.Replace What:="[!2010.xlsm]", Replacement:="", LookAt:=xlPart, _
                        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                        ReplaceFormat:=False  
   Next sh  
 
   ' Workbooks(k).Save    ' сохранение пока не нужно, файл в который копируются листы надо оставить для дальнеейшей работы)  
   Application.ScreenUpdating = True  
   ThisWorkbook.Close False 'закрываем файл с макросомбез сохраненй  
End Sub  
 
 
сархивированный и очищенный рабочий файл много весит, да и суть не поменялась, примеры были ранее

Все отлично работает. В идеале, еслиб я в далекие годы над этим задумался я б сделал наверно лист (файл) клиента и забил туда все данные клиента, а потом раскидывал данные по разным бланкам. Да база однообразная и это действительно база, но... вот в чем "петрушка" тогда надо забивать все полные данные клиента в 90% случае это избыточная информация и в результате вместо 3х минут на человека уйдет 30, или работника содержать для ввода данных. А когда я под конкретный документ ввожу толлько конкретные данные получается много быстрее. А люди сейчас пошли, что если в очереди больше 1 чел стоит, то поедут на другой конец города, лишь бы не стоять. Ребята всем спасибо. Я счастлив что Вы есть. Если у кого вопросы по налогам есть буду рад помочь. belal@kaluga.ru (Модераторы не сочтите за рекламу - помощь участникам темы бесплатная)

{quote}{login=AL1EKS}{date=11.02.2010 10:17}{thema=Re: }{post}{quote}{login=Dophin}{date=11.02.2010 09:58}{thema=}{post}ну изменятся то они как должны?  
 
все ячейки D19 на листах 4_3 должны содержать текст "тыры пыры" чтоли?{/post}{/quote}  
нет :)) там длинный текст про пенсионные взносы, я его потом вместо "тыры пыры" вставлю, а на первом листе вверку изменится текст с редакцией приказа № там "какой то", год надо изменить с 2009 на 2010 и в ячейке f35 wbahs 1,148 меняются на 1,242. т.е. в файле в который мы листы вставляем в этих ячейках старый текст, а в файле из которого берем листы там новый текст. Таким образом в макросе можно либо реализовать копирование из этих ячеек нового текста, либо я прямо в макросе писал, что в такие то ячейки всавить новый текст.  
Это знаешь как :)) берешь в руки 2 декларации за 9 и 10 год и сразу не видишь отличий, а там и поменялось то всего несколько полей, но бланк уже как бы новый{/post}{/quote}  
 
посмотри внимательней файл ранее прилагался шаблон1 - это бланк 2009г., а файл шаблон 2+ с макросом который это уже бланк 10 года

{quote}{login=Dophin}{date=11.02.2010 09:58}{thema=}{post}ну изменятся то они как должны?  
 
все ячейки D19 на листах 4_3 должны содержать текст "тыры пыры" чтоли?{/post}{/quote}  
нет :)) там длинный текст про пенсионные взносы, я его потом вместо "тыры пыры" вставлю, а на первом листе вверку изменится текст с редакцией приказа № там "какой то", год надо изменить с 2009 на 2010 и в ячейке f35 wbahs 1,148 меняются на 1,242. т.е. в файле в который мы листы вставляем в этих ячейках старый текст, а в файле из которого берем листы там новый текст. Таким образом в макросе можно либо реализовать копирование из этих ячеек нового текста, либо я прямо в макросе писал, что в такие то ячейки всавить новый текст.  
Это знаешь как :)) берешь в руки 2 декларации за 9 и 10 год и сразу не видишь отличий, а там и поменялось то всего несколько полей, но бланк уже как бы новый

{quote}{login=Dophin}{date=11.02.2010 09:42}{thema=}{post}ну вот пока так. предложение открыть файл могу завтра сделать. про желтые ячейки обратно не понял.  
 
привет Калужским ){/post}{/quote}  
Спасибо, уже что-то, я там прямо в макросе свои пожелания оставил

да просто я желтым цветом выделил те ячейки которые подлежат изменениям, это как в децких картинках - найди 5 отличий, так вот я их и выделил :)) для наглядности

{quote}{login=AL1EKS}{date=11.02.2010 09:41}{thema=Re: }{post}{quote}{login=тухачевский}{date=11.02.2010 08:02}{thema=}{post}а зачем нужно 1000 файлов  
сделайте один{/post}{/quote}  
это тысяча заполненных разных деклараций разных людей, клиенты, которые прийдут с 1 по 20 апреля за квитанциями, чтоб вовремя заплатить свои пенсионные взносы, а реквизиты уплаты изменились и мне в сжатые сроки надо всем им дать эти новые квитанции, вот я и хочу вложить в старые файлы новые квитанции{/post}{/quote}  
а далее когда клиент ушел у меня к этим старым файлам привязана карта -схема для экспорта информациив xml и сдаче этой налоговой отчетности в налоговую по телекоммуникационным каналам связи, т.е. пресловутая электронная отчетность в налоговую. Существуют программы налоговские, но они обновляются с опозданием, их структура абсолютно для меня недосягаема и что то подправить там для себе нет возможности, а база клиентов сформирована еще с 90-х годов, когда налоговых программ и в помине небыло.... вот и привязан к старым файлам периодически их модифицируя

{quote}{login=тухачевский}{date=11.02.2010 08:02}{thema=}{post}а зачем нужно 1000 файлов  
сделайте один{/post}{/quote}  
это тысяча заполненных разных деклараций разных людей, клиенты, которые прийдут с 1 по 20 апреля за квитанциями, чтоб вовремя заплатить свои пенсионные взносы, а реквизиты уплаты изменились и мне в сжатые сроки надо всем им дать эти новые квитанции, вот я и хочу вложить в старые файлы новые квитанции

Макрос должен предложить выбрать файл для открытия из определенной папки(путь/2009), этот выбранный файл надо открыть и добавить туда листы, скопировав их из файла с макросом.Затем в этих вставленных листах надо заменить ссылки на новый файл, чтоб оборвать связи. И внести незначительные текстовые поправки по определенным ячейкам в разных листах  закрытыми паролем (1604) в файле измененные ячейки прописаны в макросе и выделены желтым цветом

получиться должно так. и здесь макрос который не работает.

{quote}{login=Dophin}{date=11.02.2010 08:11}{thema=}{post}я честно все прочитал, посмотрел все приложенные файлы - что надо сделать не понял.  
 
Когда будет ясный пример:  
1. есть вот так.  
2. хочу вот так.  
3. маленький  
4. с пояснениями что изменилось, как и откуда взялось  
 
тогда будет и решение. задача вроде простенькая для макроса.{/post}{/quote}  
Есть вот так

Тихо сам с собою я веду беседу.... :)

записал макрос выполнением действий: переместить выделенные листы Шаблона2+ в файл шаблон1, внести правки в ячейки, затем выплняю Данные-изменить связи-меняю на текущую книгу... и нифига этот макрос не работает...

ребята а как на форуме задать вопрос конкретному лицу? это возможно? Че то в начале соего присутствия где то это видел а сейчас не найду...

{quote}{login=}{date=11.02.2010 12:20}{thema=Re: }{post}{quote}{login=al1eks}{date=11.02.2010 11:31}{thema=}{post}и мыслится мне, что пришел новый человек и я заполнил форму с новыми квитанциями и нужным годом т.е.в новом шаблоне, а если пришел уже бывший, то я при открытом новом шаблоне запустил макрос и он мне внес изменения в старый бланк этого человека и перенес туда новые квитанции оставив этот старый -обновившийся файл открытым для дальнейшей работы, ну вдруг там у него адрес поменялся{/post}{/quote}  
-------------------------  
Сдается что у Вас неверный системный подход:)  
Есть 1 (2-3) не важно сколько ТИПОВЫХ бланка. Вам необходимо подставить данные клиента и распечатать.  
Делаем базу клиентов с их реквизитами. Пришел старый - Выбираем ФИО из списка - и печатаем бланк. Пришел новый - вносим в базу и повторяем ФИО - Печать.  
Все выше написанное сугубо ИМХО  
Игорь67{/post}{/quote}  
Я раньше так и делал, копировал поле ввода с данными клиента в новый шаблон, но все развивалось давно и постепенно, поле ввода было проще и небыло защит, а потом файлом стали пользоваться помощники (жена и врослеющий ребенок) и пришлось поставить защиты, чтоб не попортили , в результате копировать теперь надо кусками. А есть же по сути уже все готовое со всеми данными, надо лишь добавить овые квитанции. Конечно если не получится то так и буду копировать

{quote}{login=The_Prist}{date=11.02.2010 10:56}{thema=}{post}Я тоже в тупике. Посмотрел оба файла. Что откуда куда и чем заменить вообще не понял.... Шаблоны полностью одинаковые. Различаются лишь реквизиты.    
Может Вам надо во все файлы вставить лишь одну одинаковую формулу, но пробегаться по всем шаблонам долго? Тогда попробуйте:  
-выделить через Shift(или Ctrl) столько листов, в скольких необходимо произвести полностью идентичные действия(к примеру во всех надо в ячейку А1 вставить одну и ту же формулу);  
-теперь не снимая выделения с листов делаете на активном листе нужные действия;  
-все сделанные действия будут произведены на ВСЕХ выделенных листах.{/post}{/quote}  
Авторитеты ответте, я хоть саму задачу то смог донести? :(( Менять что то в тысяче файлов можно, но в них еще нет этих новых листов которые можно было бы изменять

и мыслится мне, что пришел новый человек и я заполнил форму с новыми квитанциями и нужным годом т.е.в новом шаблоне, а если пришел уже бывший, то я при открытом новом шаблоне запустил макрос и он мне внес изменения в старый бланк этого человека и перенес туда новые квитанции оставив этот старый -обновившийся файл открытым для дальнейшей работы, ну вдруг там у него адрес поменялся

а это из которого надо взять квит (я их еще не менял, только названия листов)

{quote}{login=vikttur}{date=11.02.2010 08:29}{thema=}{post}Загадили человеку тему - а помощи никакой! Надо выкручиваться :)  
al1eks, я несколько раз перечитал вчера, сейчас вот  - но даже в последнем примере все очень обще и размыто.  
"там было 3 квит, а в новом уже должно быть 6" - в новом их три старых и одна новая, но никак не шесть.  
"в определенные ячейки некоторых листов макрос должен внести текстовые изменения  
" - чтобы не утруждать желающих помочь, Вы должны уточнить, какие данные должны меняться, показать на коротком примере - "было_так-хочу_так".  
"Существует 1000 заполненных в excel деклараций..." - думается, что это - строка (или блоки строк) с данными по конкретной декларации, но это только догадки. Вдруг они у Вас на листах тоже в виде бланков.  
 
Я смыл с себя позор бездействия! :){/post}{/quote}  
 
да , это бланки, прилагаю файл который надо изменить. в яч dp1 листа 1 изменить текст редакции, в ef1 заменить цифры, в листе 4_3 яч a19 меняется текст. Защита всех листов пароль "1604". а теперь главное, в существующих файлах 2 квит , налог по району и пенсионка, в 2010 году ИПшнии будут платить пенсионку по новому + медицину и (если работодатель, то и за работников все поменялось)Удалять в старом файле налог не надо, старую квит пенсонки тоже потому что в реальных файлах и имена и место положение этих листов могут быть разными, ну и пусть она  там "болтается" а вот из нового шаблона надо добавить 6 новых листов квитанций. прилагаю то что нужно изменить

{quote}{login=al1eks}{date=11.02.2010 01:47}{thema=}{post}а здесь то, что должно получиться  
 
p.s. всем спасибо и доброй ночи{/post}{/quote}  
 
Ё... прицепить забыл :))

а здесь то, что должно получиться  
 
p.s. всем спасибо и доброй ночи