loop of urls

[eran3185]

Hi
I have a code that open a webpage then copy it and paste on a1
I want to know if there is a way to add a loop that take 10 webpages and paste tham on columns a1-i1
my code:
Sub test()

On Error Resume Next

Dim IE As Object

Set IE = CreateObject("InternetExplorer.Application")


IE.Navigate "CNN International - Breaking News, US News, World News and Video"


Do
If IE.ReadyState = 4 Then
IE.Visible = False
Exit Do
Else
DoEvents
End If
Loop

'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:01"))

IE.Visible = True


IE.ExecWB 17, 0 '// SelectAll

Application.Wait (Now + TimeValue("0:00:01"))



IE.ExecWB 12, 2 '// Copy selection

Application.Wait (Now + TimeValue("0:00:01"))

IE.Quit
' End With
Set IE = Nothing

Application.Wait (Now + TimeValue("0:00:01"))

Range("A1").Select
ActiveSheet.PasteSpecial Format:="Unicode Text", link:=False, _
DisplayAsIcon:=False


Application.CutCopyMode = False



End Sub

 

[DanteAmor]

Where do you have the 10 url?
Always paste in A1:I1?

 

[silver_axe007]

Could you explain where are the other links?

 

[eran3185]

I have more urls that I want to write them on column t1:t10
I want that the loop will go on those cells

 

[DanteAmor]

Always paste in A1:I1?

You did not answer that question.

If it is cell A then use the following macro. But if you should paste into the next available row then use the test2 macro at the end of this post.

Sub test()
  Dim IE As Object, i As Long
  For i = 1 To 10
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate Range("T" & i).Value
    Do
      If IE.ReadyState = 4 Then
        IE.Visible = False
        Exit Do
      Else
        DoEvents
      End If
    Loop
    
    'Wait for window to open!
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.Visible = True
    IE.ExecWB 17, 0 '// SelectAll
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.ExecWB 12, 2 '// Copy selection
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.Quit
    ' End With
    Set IE = Nothing
    Application.Wait (Now + TimeValue("0:00:01"))
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", link:=False, _
    DisplayAsIcon:=False
    Application.CutCopyMode = False
  Next
End Sub

__________________________________________________________________________

Sub test2()
  Dim IE As Object, i As Long
  For i = 1 To 10
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate Range("T" & i).Value
    Do
      If IE.ReadyState = 4 Then
        IE.Visible = False
        Exit Do
      Else
        DoEvents
      End If
    Loop
    
    'Wait for window to open!
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.Visible = True
    IE.ExecWB 17, 0 '// SelectAll
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.ExecWB 12, 2 '// Copy selection
    Application.Wait (Now + TimeValue("0:00:01"))
    IE.Quit
    ' End With
    Set IE = Nothing
    Application.Wait (Now + TimeValue("0:00:01"))
    Range("A" & Rows.Count).End(xlUp)(2).Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", link:=False, _
    DisplayAsIcon:=False
    Application.CutCopyMode = False
  Next
End Sub

 

[eran3185]

Tnx

 

[DanteAmor]

Youre welcome