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

{quote}{login=troll}{date=03.01.2012 12:47}{thema=}{post}Ну а все таки можно ли в текущий файл добавлять информацию ?{/post}{/quote}  
 
Да, можно.

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

Для начала:  
 
 
Sub tt()  
   Dim a  
   Application.ScreenUpdating = False  
   With Workbooks.Open("http://msu-ural.ru/Storage/File/FileItem/Body/src/145/%D0%BF%D1%80%D0%B0%D0%­B9%D1%81%2020-12.xls")  
       a = .Sheets(1).[b1:b100].Value
       .Close False  
   End With  
   MsgBox a(20, 1)  
   Application.ScreenUpdating = True  
End Sub

В общем поняли верно.  
В массив a() можно данные не брать - можно прямо с листа читать что нужно, но через массив быстрее, и файл можно уже закрыть - это видно в примере, msgbox выводится тогда, когда файл уже закрыт.  
Но объявление массива правильнее так:  
Dim a()  
 
Пробовал с GetObject() - что-то не пошло...

Sheets("Лист1").Range("A1").Resize(UBound(a), UBound(a, 2)) = a

Вы ведь хотели данные обработать, а не просто взять всё?  
Например так - выбираем только <=30000 оптом в Челябинске:  
 
Sub tt()  
   Dim a(), b(), i&, ii&, x As Byte  
   Application.ScreenUpdating = False  
   With Workbooks.Open("http://msu-ural.ru/Storage/File/FileItem/Body/src/145/%D0%BF%D1%80%D0%B0%D0%­B9%D1%81%2020-12.xls")  
       a = .Sheets(1).[b16].CurrentRegion.Value 'обрабатываем только первую таблицу
       .Close False    'закрываем временную книгу  
   End With  
   ReDim b(1 To UBound(a), 1 To 5)  
   For i = 1 To UBound(a)  
       If Len(a(i, 3)) Then  
           If a(i, 3) <= 30000 Then  
               ii = ii + 1  
               For x = 1 To 5: b(ii, x) = a(i, x): Next  
           End If  
       End If  
   Next  
 
   Sheets(1).Range("A1").Resize(UBound(b), 5) = b  
   Application.ScreenUpdating = True  
End Sub

Хозяин-барин...  
Просто что-то можно сделать уже виртуально, в промежутке между взять/выгрузить.

Вот что получилось)  
Sub tt()  
Dim a  
Application.ScreenUpdating = False  
With Workbooks.Open("http://msu-ural.ru/Storage/File/FileItem/Body/src/145/%D0%BF%D1%80%D0%B0%D0%­B9%D1%81%2020-12.xls")  
a = .Sheets(1).[a1:t1000].Value 'можно выбрать размер поля который мы подгружаем
.Close False 'закрываем временную книгу  
End With  
Sheets("Лист1").Range("A1").Resize(UBound(a), UBound(a, 2)) = a  
Application.ScreenUpdating = True  
 
   Cells.Select  
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone  
   Selection.Borders(xlEdgeLeft).LineStyle = xlNone  
   Selection.Borders(xlEdgeTop).LineStyle = xlNone  
   Selection.Borders(xlEdgeBottom).LineStyle = xlNone  
   Selection.Borders(xlEdgeRight).LineStyle = xlNone  
   Selection.Borders(xlInsideVertical).LineStyle = xlNone  
   Selection.Borders(xlInsideHorizontal).LineStyle = xlNone  
   Selection.Interior.ColorIndex = xlNone  
   With Selection  
       .HorizontalAlignment = xlCenter  
       .VerticalAlignment = xlBottom  
       .WrapText = False  
       .Orientation = 0  
       .AddIndent = False  
       .IndentLevel = 0  
       .ShrinkToFit = False  
       .ReadingOrder = xlContext  
       .MergeCells = False  
   End With  
   Selection.NumberFormat = "@"  
Dim rCell As Range  
For Each rCell In ActiveSheet.UsedRange  
rCell.UnMerge  
Next  
 
On Error Resume Next  
Range(Cells.Find("        Труба  электросварная  ТУ", LookIn:=xlValues, LookAt:=xlWhole).Cells(2), Cells.Find("        Труба бесшовная ТУ", LookIn:=xlValues, LookAt:=xlWhole).Cells(0)).EntireRow.Delete  
 
 
   Dim ra As Range, delra As Range  
   Application.ScreenUpdating = False    ' отключаем обновление экрана  
 
   ' ищем и удаляем строки, содержащие заданный текст  
  ' (можно указать сколько угодно значений, и использовать подстановочные знаки)  
  УдалятьСтрокиСТекстом = Array("лежалая", "Труба  электросварная  ТУ", "Труба бесшовная ТУ", "ООО", "цены", "цена", "454053,", "телефон:", "филиал", "www.msu-ural.ru,", "Региональный", "ЗАО", "Челябинск", "В валютах", "некондиционная", "Уголок", "Швеллер", "Арматура", "Катанка", "Отводы", "Отвод", "Полоса", "Трубы", "ДУ", "Трубы", "Трубы стальные электросварные", "ГОСТ 10704-91, ГОСТ10705-80", "ДУ", "оцинкованная", "профильная", "Трубы бесшовная", "Полевской", "Профнастил", "немерная")  
 
   ' перебираем все строки в используемом диапазоне листа  
  For Each ra In ActiveSheet.UsedRange.Rows  
       ' перебираем все фразы в массиве  
      For Each word In УдалятьСтрокиСТекстом  
           ' если в очередной строке листа найден искомый текст  
          If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then  
               ' добавляем строку в диапазон для удаления  
              If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)  
           End If  
       Next word  
   Next  
 
   ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)  
  If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их  
 
Dim lLastRow As Long, i As Long  
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
Application.ScreenUpdating = False  
For i = lLastRow To 1 Step -1  
If Application.CountA(Rows(i)) = 0 Then Rows(i).Delete  
Next  
Application.ScreenUpdating = True  
 
Cells.Replace What:="э/с", Replacement:=" "  
Cells.Replace What:="ГОСТ", Replacement:=" "  
Cells.Replace What:="ст.", Replacement:=" "  
Cells.Replace What:="ст", Replacement:=" "  
Cells.Replace What:="ТУ-", Replacement:=" "  
Cells.Replace What:="ТУ", Replacement:=" "  
Cells.Replace What:="н/д", Replacement:=" "  
Cells.Replace What:=", ", Replacement:=" "  
Cells.Replace What:="10704-91,", Replacement:=" "  
Cells.Replace What:="10704-91", Replacement:=" "  
Cells.Replace What:="2 сорт", Replacement:=" "  
Cells.Replace What:="г/к", Replacement:=" "  
Cells.Replace What:="17 Г1С", Replacement:="17Г1С"  
Cells.Replace What:="5650-6150", Replacement:=" "  
Cells.Replace What:="5900-8000", Replacement:=" "  
Cells.Replace What:="4000-5900", Replacement:=" "  
Cells.Replace What:="10м", Replacement:=" "  
Cells.Replace What:=" Труба", Replacement:=""  
Cells.Replace What:="ф", Replacement:=""  
Cells.Replace What:="13Х А", Replacement:="13ХА"  
 
 
Cells.Replace What:="-2000", Replacement:="-00"  
Cells.Replace What:="-2001", Replacement:="-01"  
Cells.Replace What:="-2002", Replacement:="-02"  
Cells.Replace What:="-2003", Replacement:="-03"  
Cells.Replace What:="-2004", Replacement:="-04"  
Cells.Replace What:="-2005", Replacement:="-05"  
Cells.Replace What:="-2006", Replacement:="-06"  
Cells.Replace What:="-2007", Replacement:="-07"  
Cells.Replace What:="-2008", Replacement:="-08"  
Cells.Replace What:="-2009", Replacement:="-09"  
Cells.Replace What:="-2010", Replacement:="-10"  
Cells.Replace What:="-2011", Replacement:="-11"  
Cells.Replace What:=",0 ", Replacement:=" "  
 
Cells.Replace What:="       ", Replacement:=" "  
Cells.Replace What:="      ", Replacement:=" "  
Cells.Replace What:="     ", Replacement:=" "  
Cells.Replace What:="    ", Replacement:=" "  
Cells.Replace What:="   ", Replacement:=" "  
Cells.Replace What:="  ", Replacement:=" "  
 
   Columns("F:F").Select  
   Selection.Delete Shift:=xlToLeft  
   Columns("A:A").Select  
   Selection.Delete Shift:=xlToLeft  
 
Dim b As Long, aTxt As String  
aTxt = "тн"  
For b = 1 To 2000  
If Not IsEmpty(Cells(b, 2)) Then Cells(b, 2) = Cells(b, 2) & aTxt & " "  
Next  
 
Dim x As Long  
For x = 1 To 2000  
If Not IsEmpty(Cells(x, 3)) Then Cells(x, 3) = Cells(x, 3) & "-" & Cells(x, 4)  
Next  
 
Columns("D:D").Select  
Selection.Delete Shift:=xlToLeft  
 
On Error Resume Next  
Columns(1).SpecialCells(xlCellTypeConstants).Offset(, 3) = "Металлснаб-Челябинск"  
Columns(1).SpecialCells(xlCellTypeConstants).Offset(, 4) = "www.msu-ural.ru"  
Rows.AutoFit  
Columns.AutoFit  
End Sub