Сделайте пример в файле Excel

{quote}{login=EducatedFool}{date=30.08.2009 12:02}{thema=Re: }{post}{quote}{login=}{date=30.08.2009 11:59}{thema=}{post}Сделайте пример в файле Excel{/post}{/quote}  
 
А зачем наглеть-то?  
Нет, чтобы самому подготовить пример в виде файла, чтобы нам легче было помочь...  
 
Сомневаюсь, что будет много желающих помочь при таких требованиях...{/post}{/quote}  
 
Сорри я тут новенький....

{quote}{login=Юрий М}{date=30.08.2009 12:33}{thema=}{post}Я так понимаю, что это нужно сделать макросом? И, видимо, строки не удалять, а просто новый столбец заполнить нужными данными.{/post}{/quote}  
 
Хоть макросом, хоть автоматически, без разницы.

А также автоматически :-)

Первый файл работает а можно ли сделать так что бы со второго столбца не удалялись данные?  
А вот второй вариант почему то не работает. Но все равно ОГРОМНОЕ СПАСИБО!!!

Установить "кривые кавычки" можно сочетанием клавиш CTRL+SHIFT+ENTER (просто выражение где-то на этом форуме понравилось :))

А где Ваш файл?

Вот формулами (сжимаем пробелы где только можно и где нельзя...)

{quote}{login=kim}{date=30.08.2009 03:25}{thema=}{post}Вот формулами (сжимаем пробелы где только можно и где нельзя...){/post}{/quote}  
 
Файл рабочий. Спасибо за труд!!!

{quote}{login=}{date=30.08.2009 04:24}{thema=}{post}Предпоследний файл с макросом не работал, т.к. вы не вставили в него свои данные. Вот с вашими данными.{/post}{/quote}  
Вот теперь отлично работает, даже когда повторно на кнопку жмешь ошибка не выскакивает.  
А можно ли в экселе решить вот эту проблему?  
Проблема сейчас в другом есть веб страничка с которой я импортирую данные  
ее адресс: www.lan.ua/Look.aspx?issue=431&rub=115  
Макрос для автоматического импорта данных выглядит так:  
 
With ActiveSheet.QueryTables.Add(Connection:= _  
"URL;http://www.lan.ua/Look.aspx?issue=431&rub=115", Destination:=Range( _  
"$A$1"))  
.Name = "Look.aspx?issue=431&rub=115"  
.FieldNames = True  
.RowNumbers = False  
.FillAdjacentFormulas = False  
.PreserveFormatting = True  
.RefreshOnFileOpen = False  
.BackgroundQuery = True  
.RefreshStyle = xlInsertDeleteCells  
.SavePassword = False  
.SaveData = True  
.AdjustColumnWidth = True  
.RefreshPeriod = 0  
.WebSelectionType = xlEntirePage  
.WebFormatting = xlWebFormattingNone  
.WebPreFormattedTextToColumns = True  
.WebConsecutiveDelimitersAsOne = True  
.WebSingleBlockTextImport = False  
.WebDisableDateRecognition = False  
.WebDisableRedirections = False  
.Refresh BackgroundQuery:=False  
End With  
Она импортируеться как видим в А1,    
в В1 мне нужно импортировать http://www.lan.ua/Look.aspx?issue=431&rub=115&page=1  
в С1 http://www.lan.ua/Look.aspx?issue=431&rub=115&page=2  
А на другой лист тоже самое только уже:  
A1 http://www.lan.ua/Look.aspx?issue=432&rub=115  
B1 http://www.lan.ua/Look.aspx?issue=432&rub=115&page=1  
С1 http://www.lan.ua/Look.aspx?issue=432&rub=115&page=2  
Реально ли сделать так что бы в первую ячейку я вносил 431 а во вторую 433 и оно мне на разных листа импортировало данные с инета так как я описал выше.

{quote}{login=}{date=30.08.2009 05:03}{thema=}{post}что-то я не могу зайти на сайт http://www.lan.ua/Look.aspx?issue=431&rub=115{/post}{/quote}  
 
Попробуйте любой другой сайт это не важно, главное как сделать так что бы менялось 431 на 432 потом на 433 потом на 434 и тд.

{quote}{login=}{date=30.08.2009 05:21}{thema=}{post}Если честно, то мне трудно разобраться что вам нужно, т.к.  
1) Я не могу понять вашу фразу "Реально ли сделать так что бы в первую ячейку я вносил 431 а во вторую 433"  
- что за первая ячейка, что за вторая ячейка?  
2) Ваша ссылка не работает, и соответственно я не могу проверить работу макроса. Ваше предложение по тестированию на другом сайте я не очень понимаю, т.к. не знаю, что я должен получить из другого сайта  
3) Вы сами в макросах разбираетесь? Я вам могу дать пример, который вы сможете попробовать переделать под себя.  
4) Трудно что-то делать, когда нет образца, как это должно выглядеть в конечном итоге.  
 
См. файл. Для просмотра кода нажмите Alt+F11{/post}{/quote}  
 
СУПЕР!!! УРА!!! ОГРОМНОЕ СПАСИБО! Все работает именно так как я хотел.  
Просто я не знал как подставить переменную в адресс теперь по вашему коду я это вижу. Еще раз огромное спасибо!

А если требуеться еще задействовать ячейку А2 что бы с нее брались данные что нужно дописать в коде?  
Я далек от ВБА дописал по логике но не работает...  
дописанный код:  
Sub Макрос1()  
Dim iValue As String  
Dim iValue2 As String  
   iValue = [A1]
   iValue2 = [А2]
   If iValue = "" Then  
       MsgBox "Введите номер в ячейку А1 (Например: 431, 432)", 48, "Ошибка"  
       Exit Sub  
   End If  
   If iValue2 = "" Then  
       MsgBox "Введите номер в ячейку А2 (Например: 431, 432)", 48, "Ошибка"  
       Exit Sub  
   End If  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue & "&rub=115", "A1")  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue & "&rub=115&page=1", "B1")  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue & "&rub=115&page=2", "C1")  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue2 & "&rub=115", "D1")  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue2 & "&rub=115&page=1", "E1")  
   Call InsertQueryTable("URL;http://www.premier.ua/Look.aspx?issue=" & iValue2 & "&rub=115&page=2", "F1")  
End Sub  
 
Sub InsertQueryTable(sCon As String, sDist As String)  
   With ActiveSheet.QueryTables.Add(Connection:=sCon, Destination:=Range(sDist))  
       .Name = Mid(sCon, 23, Len(sCon))  
       .FieldNames = True  
       .RowNumbers = False  
       .FillAdjacentFormulas = False  
       .PreserveFormatting = True  
       .RefreshOnFileOpen = False  
       .BackgroundQuery = True  
       .RefreshStyle = xlInsertDeleteCells  
       .SavePassword = False  
       .SaveData = True  
       .AdjustColumnWidth = True  
       .RefreshPeriod = 0  
       .WebSelectionType = xlEntirePage  
       .WebFormatting = xlWebFormattingNone  
       .WebPreFormattedTextToColumns = True  
       .WebConsecutiveDelimitersAsOne = True  
       .WebSingleBlockTextImport = False  
       .WebDisableDateRecognition = False  
       .WebDisableRedirections = False  
       .Refresh BackgroundQuery:=False  
   End With  
End Sub  
 
Исходный код:  
 
Sub Макрос1()  
Dim iValue As String  
   iValue = [A1]
   If iValue = "" Then  
       MsgBox "Введите номер в ячейку А1 (Например: 431, 432)", 48, "Ошибка"  
       Exit Sub  
   End If  
   Call InsertQueryTable("URL;http://www.lan.ua/Look.aspx?issue=" & iValue & "&rub=115", "A1")  
   Call InsertQueryTable("URL;http://www.lan.ua/Look.aspx?issue=" & iValue & "&rub=115&page=1", "B1")  
   Call InsertQueryTable("URL;http://www.lan.ua/Look.aspx?issue=" & iValue & "&rub=115&page=2", "C1")  
End Sub  
 
Sub InsertQueryTable(sCon As String, sDist As String)  
   With ActiveSheet.QueryTables.Add(Connection:=sCon, Destination:=Range(sDist))  
       .Name = Mid(sCon, 23, Len(sCon))  
       .FieldNames = True  
       .RowNumbers = False  
       .FillAdjacentFormulas = False  
       .PreserveFormatting = True  
       .RefreshOnFileOpen = False  
       .BackgroundQuery = True  
       .RefreshStyle = xlInsertDeleteCells  
       .SavePassword = False  
       .SaveData = True  
       .AdjustColumnWidth = True  
       .RefreshPeriod = 0  
       .WebSelectionType = xlEntirePage  
       .WebFormatting = xlWebFormattingNone  
       .WebPreFormattedTextToColumns = True  
       .WebConsecutiveDelimitersAsOne = True  
       .WebSingleBlockTextImport = False  
       .WebDisableDateRecognition = False  
       .WebDisableRedirections = False  
       .Refresh BackgroundQuery:=False  
   End With  
End Sub  
 
       .FillAdjacentFormulas = False  
       .PreserveFormatting = True  
       .RefreshOnFileOpen = False  
       .BackgroundQuery = True  
       .RefreshStyle = xlInsertDeleteCells  
       .SavePassword = False  
       .SaveData = True  
       .AdjustColumnWidth = True  
       .RefreshPeriod = 0  
       .WebSelectionType = xlEntirePage  
       .WebFormatting = xlWebFormattingNone  
       .WebPreFormattedTextToColumns = True  
       .WebConsecutiveDelimitersAsOne = True  
       .WebSingleBlockTextImport = False  
       .WebDisableDateRecognition = False  
       .WebDisableRedirections = False  
       .Refresh BackgroundQuery:=False  
   End With  
End Sub

{quote}{login=}{date=30.08.2009 06:11}{thema=}{post}Вот в этой строке    
 
iValue2 = [A2]
 
Буква А в квадратных скобках - должна быть АНГЛИЙСКОЙ, а не русской{/post}{/quote}  
 
И в правду в этом была ошибка. Спасибо.  
 
P.S. Удивляюсь вашему умению...