Спасибо!

Прошу помочь.  
Необходимо сравнивать значения в столбце С5 и В5, затем  подставлять значение 160(т.е. проверять два искомых значения в таблице С7:Е12 "Груши" и "зеленые" и ставить им в соответствие значение 160) в бланк в ячейку I8. См. прикрепленный файл.  
Заранее спасибо.

{quote}{login=Казанский}{date=02.12.2010 05:28}{thema=}{post}Моё кодо :){/post}{/quote}  
 
Вы не забыли про меня?

еще очень бы хотелось, чтобы выполнялось не просто копирование с листа на лист, а копирование - спец.вставка/значения. исходные листы содержат числа, вычисляемые формулами, и при копировании копируются формулы, а очень бы хотелось, чтобы приходили значения.

{quote}{login=Казанский}{date=02.12.2010 05:28}{thema=}{post}Моё кодо :)  
Где Вам удобнее указать список файлов и имя листа? Я бы сделал это на отдельном листе.{/post}{/quote}  
 
да пожалуйста. т.к. это чисто технически лист, его же можно сделать скрытым, что не повлияет на работоспособности, так ведь? ps: отличный код :)

Sub FiziK()  
   
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов  
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат  
Const blInsertNames = True  'вставлять строку заголовка (книга, лист) перед содержимым листа  
   
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _  
   i As Integer, stbar As Boolean, clTarget As Range  
   
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию  
ChDir strStartDir  
On Error GoTo 0  
With Application    'меньше писанины  
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)  
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла  
Set wbTarget = Workbooks.Add(template:=xlWorksheet)  
Set shTarget = wbTarget.Sheets(1)  
   .ScreenUpdating = False  
   stbar = .DisplayStatusBar  
   .DisplayStatusBar = True  
   
For i = 1 To UBound(arFiles)  
   .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)  
   Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)  
   For Each shSrc In wbSrc.Worksheets  
       If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой  
           Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)  
           If blInsertNames Then  
               clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name  
               Set clTarget = clTarget.Offset(1, 0)  
           End If  
           shSrc.UsedRange.Copy clTarget  
       End If  
   Next  
   wbSrc.Close False   'закрыть без запроса на сохранение  
Next  
   .ScreenUpdating = True  
   .DisplayStatusBar = stbar  
   .StatusBar = False  
   
On Error Resume Next    'если указанный путь не существует и его не удается создать,  
                       'обзор начнется с последней использованной папки  
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir  
ChDir strSaveDir  
On Error GoTo 0  
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")  
   
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя  
   GoTo save_err  
Else  
   On Error GoTo save_err  
   wbTarget.SaveAs arFiles  
End If  
End  
save_err:  
   MsgBox "Книга не сохранена!", vbCritical  
End With  
End Sub

Здравствуйте!  
 
Подскажите пожалуйста, как можно подправить данный код (взят с http://forum.ixbt.com/topic.cgi?id=23:34091) следующим образом:  
 
- имена нужных файлов указаны/прописаны заранее (их штук 10)  
- во всех книгах берутся данные только с одного листа (во всех книгах называется одинаково)  
- строки собираются на конкретный лист конкретной книги (в которой макрос и расположен)  
 
Вот сам макрос:  
 
{quote}Sub Объединение_файлов()  
   
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов  
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат  
   
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _  
   i As Integer, stbar As Boolean  
   
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию  
ChDir strStartDir  
On Error GoTo 0  
With Application    'меньше писанины  
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)  
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла  
Set wbTarget = Workbooks.Add(template:=xlWorksheet)  
   .ScreenUpdating = False  
   stbar = .DisplayStatusBar  
   .DisplayStatusBar = True  
   
For i = 1 To UBound(arFiles)  
   .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)  
   Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)  
   For Each shSrc In wbSrc.Worksheets  
       If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой  
           Set shTarget = wbTarget.Sheets.Add(after:=wbTarget.Sheets(wbTarget.Sheets.Count))  
           shTarget.Name = Left(Replace(wbSrc.Name, ".xls", "") & "." & shSrc.Name, 31)  
           shSrc.Cells.Copy shTarget.Range("A1")  
       End If  
   Next  
   wbSrc.Close False   'закрыть без запроса на сохранение  
Next  
   .ScreenUpdating = True  
   .DisplayStatusBar = stbar  
   .StatusBar = False  
   
If wbTarget.Sheets.Count = 1 Then 'не добавлено ни одного листа  
   MsgBox "В указанных книгах нет непустых листов, сохранять нечего!"  
   wbTarget.Close False  
   End  
Else  
   .DisplayAlerts = False  
   wbTarget.Sheets(1).Delete  
   .DisplayAlerts = True  
End If  
   
On Error Resume Next    'если указанный путь не существует и его не удается создать,  
                       'обзор начнется с последней использованной папки  
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir  
ChDir strSaveDir  
On Error GoTo 0  
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")  
   
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя  
   GoTo save_err  
Else  
   On Error GoTo save_err  
   wbTarget.SaveAs arFiles  
End If  
End  
save_err:  
   MsgBox "Книга не сохранена!", vbCritical  
End With  
End Sub{/quote}

спасибо!

Это то, что надо!!! Спасибо!

Есть база данных оборудования, в которой в поле Наименование встречаются однотипные модели, но их написание может сильно различаться. Например Принтеры Xerox M20i могут встречаться как Принтер M20 или Xerox M20 либо Xerox. Необходимо напротив каждой записи поставить тип оборудования, взятый из другой заготовленной таблицы. См. приложение. Заранее, спасибо.

ок подожду

... с кэшем разобрался. Все отображается в MS Query.

Еще пару вопросов, можно?    
'Неделя 1$' - это ссылка на лист или имя диапазона?    
для чего знак "$"  
как должны быть подготовлены листы книги, чтоб такой запрос правильно работал [я имею в виду если, например, не будет заголовков или таблицы будут разной размерности, это будет работать?]
можно ли увидеть результат запроса (т.е. кэш) для отладки?  
я так понимаю, SQL-запрос может из разных книг дергать таблицы?

Спасибо! Буду разбираться дальше.  
... в примере не получается посмотреть запрос. Я приложил копии экранов.  
Если не затруднит, опишите пож-та последовательность переходов для создания запроса с использования SQL.    
Если я правильно понимаю, начало: Данные->Импорт внешних данных->Создать запрос.  
Далее - Файлы Excel*->OK, Выбираем XLS-файл с несколькими таблицами... [в файле должны быть таблицы, которые обозначены именами], в интерфейсе MS Query появляются несколько таблиц, а в окне с появляются однотипные одноименные столбцы из разных таблиц. Чтобы их консолидировать, я предполагаю, надо написать что-то волшебное...я теряюсь. Помогите разобраться, пож.

{quote}{login=Serge 007}{date=21.03.2010 07:47}{thema=}{post}

http://www.planetaexcel.ru/forum.php?thread_id=14518 <BR>Это первая тема, волнующая многих. <BR>Как созздать сводную из нескольких листов? Не рационально, но актуально :-)

{/post}{/quote}  
 
Сергей, объясни пож-та, как сделать такой запрос... чтоб получилась база, объединяющая несколько таблиц с одинаковыми заголовками. С остальным я наверное справлюсь.

Добрый день. Подскажите, как сделать.    
Есть несколько практически одинаковых таблиц на разных листах (большинство заголовков совпадают). Требуется сделать сводную таблицу по этим данным. Сводную хотелось бы получить по образцу (лист "Сводный"). Никак не могу посредством нескольких диапазонов консолидации получить удобочитаемый вид. Файл - в приложении.

Спасибо за напутствие. Сам чевойтось протупил. Файл прилагаю

С удовольствием бы дал исходник, но служба безопасности меня порвёт за это. Поэтому буду крайне признателен взять макрос и попробовать настроить. Пробовал записать макрос в автоматическом режиме, но получается только ё-нь какая-то. 8-(

Здравствуйте! Ежедневно получаю автоматически некоторую таблицу на 15 столбцов и 50-65 тыс. строк. и удаляю вручную два столца, через автофильтр некоторые строки (15-20 тыс), затем сортирую по двум критериям и за исключением последнего столбца переношу в др. книгу. Естественно всё это делается вручную и занимает уйму времени. Вопрос следующий: подскажите как можно через макрос организовать сей процесс автоматически? И вообще это возможно?  
Заранее благодарен (пока что устно).