Hugo, доброго времени суток
Прошу прощения не хватило понятия что Вы пишите
Нашел на соседнем форму разъяснения по Вашей функции
Спасибо вариант оказался наиболее действенный  

Nordheim, доброго времени суток
Столбец "Номер товара" это товар
Столбец "Место Инв-ции Код" это код, который необходимо вывести возле товара  

Спасибо всем что откликнулись
Стараюсь писать как можно грамотнее и проще но получается как получается
Nordheim, вопрос можно ли переехать этот макрос в другой файл?
При вставке своих данных в Ваш файл все прекрасно работает
Спрашивали может в оригинале структура файла другая прикрепил кусок оригинала  

skais675, спасибо
Попробовал на реальном файле или даже вставить данные в Ваш файл не работает

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

Михаил спасибо.    
Сейчас с этим файлом сработало.    
Но СЧЁТ() не подойдет в случае если есть значения в верхней и нижней ячейках тогда столбец нужно считать как 1, а не простое кол-во значений.  
Как тогда правильно написать формулу  
Спасибо

Здравствуйте.    
В ячейках А2:U2 могут быть и числа и текст нужно выбрать только числа. По форуму ответа не нашел и сам не могу сообразить как.      
Заранее благодарен

Еще раз приношу свои извинения.  
Впредь буду внимательнее

2 GIG_ant спасибо сработало будем дальше копать    
2 Serge 007 прошу прощения что сразу не прикрепил файл, но условие написал в шапке темы

Так вот вопрос в том что даже явно одинаковые ячейки пишет что "ложь"

Есть ячейка во временном формате "ЧЧ:ММ" ее нужно сравнить с ячейкой в числовом формате равны или не равны значения    
Спасибо

Деньги, наконец-то, получил.

Sub DelRows()  
   On Error Resume Next  
   Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
End Sub

))))

Sub CloseNonActiveWorkbooks()  
Dim Wb As Workbook, MyWb As Workbook  
   Set MyWb = ActiveWorkbook  
   For Each Wb In Workbooks  
       If Wb.Name <> MyWb.Name Then  
           Wb.Close SaveChanges:=False 'True - если нужно сохранить книгу при закрытии  
       End If  
   Next Wb  
End Sub

угу, а так могу ещё предложить    
 
Sheets("Результат").UsedRange.Offset(1).EntireRow.Clear

ну,    
 
1) Юра тут вообще не причём )), он обрабатывает данные в массивах, и выгружает массив на лист. Тут форматирования ячеек не может переноситься. Он же не копирует ячейки с одного листа на лист "Результат". Так что форматирование тут не переносится  
 
2) очистить предлагаю так  
 
   With Sheets("Результат")  
       LastRow = Cells(Rows.Count, 1).End(xlUp).Row  
       .Range("A2:E" & LastRow + 1).Clear  
   End With

ну, да, со словарём быстрее. Объединил макросы от Юрия и Игоря и вывел время

не, Вить. Ты думаешь, что диапазон будет расширяться от второй строки и вниз до LastRow, но если LastRow = 1, то диапазон расширяется от второй строки вверх (до строки 1) ))

Т.к. в 1-й строке на листе "Результат" идёт шапка таблицы. Если +1 не сделать, то шапка очиститься

а, кстати, какая разница повторяется ли товар или нет на одной строке. У нас задача "найти в новом прайсе позиции, совпадающие по колонке А1 с оной в старом прайсе и скопировать их на отдельный лист."  
 
Это говорит о том, что даже если код заказа и повторяется, то номер у него будет один и тот же. Т.е. мы пользователю говорим, что код "GJI2322322R0001" есть и там и там. Всё. А сколько там повторений на листе, это уже другая задача.    
Но повторюсь, в Прайс-листах обычно товар не повторяется.

ну, это да. Нужно автора спросить - встречаются ли случаи, что Коды заказа повторяются на одном и том же листе?  
 
P.S. Хотя та же ВПР - тоже берёт первое сверху значение, хоть их там 20 будет повторов.  
 
P.P. Но что-то мне подсказывает, что в Прайс-листе никогда товар не повторяется.

Юрий, ваш макрос отлично написано, но мне кажется нужно добавить инструкцию    
Exit For после строки x = x + 1  
 
т.е. если мы нашли такой код, заполняем ArrRez, а дальше выходим из цикла For j = 1 To UBound(ArrOld, 1). Это будет лишним затраченным временем.    
 
Поэтому предлагаю так  
...  
ArrRez(x, 4) = ArrNew(i, 4)  
ArrRez(x, 5) = ArrNew(i, 5)  
x = x + 1  
 
Exit For  
 
End If

Похоже меня кинули.  
 
21 декабря я послал Александру письмо с моими контактами  
21 декабря получил от Александра большую таблицу с 1014 страницами (выгрузка из PDF файла. Это был электронный каталог японской фирмы KAYABA, они производят амортизаторы для автомобилей), из которых нужно было обработать 715 и создать общую сводную таблицу, но в нужном Александру виде и сам пример окончательного вида таблицы. Таблица сильно отличалась от примера, который выложил Александр в этой теме, т.е. макрос пришлось полностью переписывать и существенно добавлять.  
22 декабря я часов за 5 написал макрос (порядка 150 строк), который объединяет информацию с 715 листов и преобразовывает таблицу Александра в нужный ему вид и отправил готовый результат ему на почту (без макроса).  
23 декабря я получил письмо, что его всё устраивает и он предоставить мне ещё 500-600 приблизительно таких же таблиц (выгрузок из PDF файлов), но видно уже других фирм (не KAYABA). Соответственно, под них нужно будет писать уже другие макросы. Мы договорились о цене, он попросил меня дать ему мои реквизиты для оплаты и пообещал выслать мне деньги за сделанную таблицу и выслать новые каталоги.    
24 декабря я выслал ему реквизиты и попросил выслать мне остальные таблицы.  
Но с 23 числа я больше не получил от Александра ни каких писем и денег за готовую таблицу.  
28 числа я послал ему письмо с вопросом, когда я смогу получить деньги и новые таблицы, но ответа до сих пор не последовало, т.е. человек с 23 числа пропал. Звонить на телефон ему я не стал, если человек не отвечает на почту, то скорее всего и по телефону не захочет со мной общаться.  
 
Его контакты:  
Имя: Александр  
Почта: tex.sibia@yandex.ru  
Телефон: Телефон: 89041171674  
 
Павел

Вашу формулу не смотрел, но количество точек в ячейке А1 можно посчитать так  
 
=ДЛСТР(A1)-ДЛСТР(ПОДСТАВИТЬ(A1;".";""))

не за что )  
 
P.S. ужасть, в 4 утра написал код, сейчас смотрю на него, вроде, ник мой, а код какой-то незнакомый, еле вспомнил, что это действительно я писал ))

Кирилл, прошу прощения, но у тебя неправильная последняя строка последнего макроса. Там нужно диапазон расширить ещё на 1 строку, т.е. вместо строки  
 
Worksheets("Не входят в справочник").Range("A1").Resize(UBound(arr)) = Application.Transpose(arr)  
 
нужно написать  
 
Worksheets("Не входят в справочник").Range("A1").Resize(UBound(arr) + 1) = Application.Transpose(arr)  
 
т.к. массив arr имеет 5 значений (размерность 0..4). Последний 5-й элемент массива "сушки" не выгрузятся на лист.

Function Del_Slash(Rng As Range) As String  
Dim i&  
   For i = Len(Rng) To 1 Step -1  
       If Mid(Rng, i, 1) <> "\" Then  
           Del_Slash = Left(Rng, i)  
           Exit Function  
       End If  
   Next i  
End Function  
 
 
см. файл

Кирилл, что-то у тебя столбцы Счёт и Клиент местами поменялись. Наверное сперва нужно  
 
With .PivotFields(2)    
 
а потом  
 
With .PivotFields(3)    
 
 
А так прикольно)) как вы только разбираетесь в этом (SQL, Pivot tables, Connections & so on )

Sub InputSums()  
   With Sheets("GLREPORT")  
       'сумма красных  
       .Cells(.[H7].End(xlDown).Row, "H").Offset(3, 0).Formula = "=SUM(H7:H" & .[H7].End(xlDown).Row & ")"
       'сумма зелёных  
       .Cells(.[G7].End(xlDown).Row, "G").Offset(4, 1).Formula = "=SUM(G7:G" & .[G7].End(xlDown).Row & ")"
       'сумма каких-то коричневых  
       Dim iLastRow&  
       iLastRow = .Cells(Rows.Count, "H").End(xlUp).Row  
       .Cells(iLastRow, "H").Offset(3, 0).Formula = "=SUM(H" & .Cells(iLastRow, "H").End(xlUp).Row & ":H" & iLastRow & ")"  
       'сумма голубых  
       .Cells(iLastRow, "H").Offset(4, 0).Formula = "=SUM(G" & .Cells(iLastRow, "G").End(xlUp).Row & ":G" & iLastRow & ")"  
   End With  
End Sub