ну, если "блонди", то фотку в студию ) мы проверим, а то вдруг вы лысый мужик с бородой )  
 
А по поводу сохранения картинок, по-моему, тут такие темы уже были. Поищите поиском

и это... я всё стесняюсь спросить, а вы Правила форума читали? )  
 
P.S. У меня такое ощущение, что я сам с собой разговариваю )

смотрите, я ещё одну ссылку для вас нашёл  
 
http://www.excel-vba.ru/chto-umeet-excel/kak-soxranit-kartinki-iz-lista-excel-v-kartinki-jpg/

Очень:  
Не огорчаюсь, если люди меня не понимают, - огорчаюсь, если я не понимаю людей. (Конфуций)  
:)  
Очевидно скоро вспомните и это:  
Не говорить с человеком, с которым можно говорить, значит потерять человека; говорить с человеком, с которым нельзя говорить, значит терять слова. Умный человек не теряет человека и не теряет слов. (Конфуций)

ой, кажется получилось, сама  не  поняла как, теперь надо это всё повторить для других  листов, пошла дальше страдать.  
Спасибо, что  ткнули носом.

эээ, неее, сперва фотку свою покажите )  
 
P.S. Вы это... подписываться не забывайте, вы же автор темы )

Автор, давайте ещё раз - Вы Правила нашего форума читали? Когда создавали эту тему видели сообщение, что нельзя выкладывать файлы больше 100кб, а вы целый мегабайт почти выкладываете. Все файлы больше 100кб с утра Модераторы удалят из этой темы

{quote}{login=}{date=28.12.2011 04:26}{thema=}{post}Автор, давайте ещё раз - Вы Правила нашего форума читали? Когда создавали эту тему видели сообщение, что нельзя выкладывать файлы больше 100кб, а вы целый мегабайт почти выкладываете. Все файлы больше 100кб с утра Модераторы удалят из этой темы{/post}{/quote}  
 
я больше  не буду

эх, Галя-Галя...

вот мне  нужно  из  1 листа скопировать артикулы во  второй, но , чтоб там не  были объединены ячейки, чтоб на  втором листе  получилось как  в файле    
надеюсь  нормальный файл  вставила, глаза уже в кучу

{quote}{login=}{date=28.12.2011 05:10}{thema=}{post}приблизительно так  
 
Sub CollectItems()  
   Dim rCell As Range  
   Application.ScreenUpdating = False  
   For Each rCell In Sheets("Лист1").Range("A1:A" & Sheets("Лист1").Cells(Rows.Count, "A").End(xlUp).Row)  
       If Len(rCell) Then  
           With Sheets("Лист2")  
               .Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A") = rCell.Value  
           End With  
       End If  
   Next rCell  
   Application.ScreenUpdating = True  
   MsgBox "Конец", vbInformation, ""  
End Sub{/post}{/quote}  
 
ой, спасибо!!! огромное. получилось!!!    
 
А  Вы  не  могли бы  ещё  переделать вот это    
Sub Rename_Shapes()  
   Dim oShape As Object, li As Long  
   For Each oShape In ActiveSheet.Shapes  
       li = li + 1  
       oShape.Name = Range("A" & Range(oShape.TopLeftCell.Address).Row).Text  
   Next oShape  
End Sub  
 
для  моего  файла. там макрос написан  с учётом того, что  артикул  в столбце  A? а картинка  с С, а у меня  по  другому, а когда меняю свои столбцы местами, для некоторых  картинок не действует макрос почему-то

{quote}{login=}{date=28.12.2011 05:35}{thema=}{post}так что там по поводу вашей фотки? А то помогаю-помогаю, ссылок сколько накидал, макрос написал, а фотки всё нет и нет (  
 
P.S. А вы территориально откуда? ){/post}{/quote}  
 
вот честно, не до  фоток сейчас, к сожалению. время почти 6 утра, скоро  вставать, а я не  ложилась ещё

{quote}{login=}{date=28.12.2011 05:43}{thema=}{post}  
 
Sub Rename_Shapes()  
   Dim oShape As Object, iNewName$  
   For Each oShape In ActiveSheet.Shapes  
       iNewName = Range("C" & Range(oShape.TopLeftCell.Address).Row).Text  
       If iNewName = "" Then  
           iNewName = Range("C" & Range(oShape.TopLeftCell.Address).Row - 1).Text  
       End If  
       oShape.Name = Trim(iNewName)  
       iNewName = ""  
   Next oShape  
End Sub{/post}{/quote}  
 
спасибищееееее, Вы гений!