Copy content of Several Webpages

[parscon]

IHi
I have thsi VBA code that can copy http://www.website.com/home/ and paste in excel now my question is i need to copy several page with different url
Like :
http://www.website.com/home/
copy above url and do run some code and again next url
http://www.website.com/Data2/
copy above url and do run some code and again next url
http://www.website.com/Apple/
copy above url and do run some code and again next url
http://www.domian.com/BoB/

Hope you will understand

Sub webCopier()
Dim lnk As Object, ie As Object, doc As Object, i As Long, R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range, delAdr As String, LR As Long
 Set ie = CreateObject("InternetExplorer.Application")
 With ie
 .Visible = True
 .navigate "http://www.website.com/home/"
 
 Do Until .readyState = 4: DoEvents: Loop
 Application.wait (Now() + TimeValue("00:00:5"))
 Set doc = ie.document
 .ExecWB 17, 0 '// SelectAll
 .ExecWB 12, 2 '// Copy selection
 .Quit
 End With
 Set ie = Nothing
 Range("A1").Select
 ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
 DisplayAsIcon:=False

'Some of my code will be place here. 
End Sub

[Jan Karel Pieterse]

Something like:

Sub Demo()
    WebCopier "http://www.website.com/home/"
    WebCopier "http://www.website.com/home/"
    WebCopier "http://www.website.com/Data2/"
    WebCopier "http://www.website.com/Apple/"
    WebCopier "http://www.domian.com/BoB/"
End Sub

Sub webCopier(sURL As String) 
    Dim lnk As Object, ie As Object, doc As Object, i As Long, R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range, delAdr As String, LR As Long 
    Set ie = CreateObject("InternetExplorer.Application") 
    With ie 
        .Visible = True 
        .navigate sURL 
         
        Do Until .readyState = 4: DoEvents: Loop 
            Application.wait (Now() + TimeValue("00:00:5")) 
            Set doc = ie.document 
            .ExecWB 17, 0 '// SelectAll
            .ExecWB 12, 2 '// Copy selection
            .Quit 
        End With 
        Set ie = Nothing 
        Range("A1").Select 
        ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _ 
        DisplayAsIcon:=False 
         
         'Some of my code will be place here.
    End Sub

[Jan Karel Pieterse]

Something like:

Sub Demo()
    WebCopier "http://www.website.com/home/"
    WebCopier "http://www.website.com/home/"
    WebCopier "http://www.website.com/Data2/"
    WebCopier "http://www.website.com/Apple/"
    WebCopier http://www.domian.com/BoB/
End Sub

Sub webCopier(sURL As String)
    Dim lnk As Object, ie As Object, doc As Object, i As Long, R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range, delAdr As String, LR As Long
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .navigate sURL
        
        Do Until .readyState = 4: DoEvents: Loop
            Application.wait (Now() + TimeValue("00:00:5"))
            Set doc = ie.document
            .ExecWB 17, 0 '// SelectAll
            .ExecWB 12, 2 '// Copy selection
            .Quit
        End With
        Set ie = Nothing
        Range("A1").Select
        ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False
        
        'Some of my code will be place here.
    End Sub

[mancubus]

Hi Jan.how about adding a worksheet/range parameter to sub where web contents will be pasted.

[Jan Karel Pieterse]

You mean like so:

 Sub Demo()
     WebCopier "http://www.website.com/home/", Worksheets("Sheet2").Range("A2")
     WebCopier "http://www.website.com/home/", Worksheets("Sheet2").Range("B2")
     WebCopier "http://www.website.com/Data2/", Worksheets("Sheet2").Range("C2")
     WebCopier "http://www.website.com/Apple/", Worksheets("Sheet2").Range("D2")
     WebCopier "http://www.domian.com/BoB/", Worksheets("Sheet2").Range("E2")
 End Sub

 Sub webCopier(sURL As String, oDestination As Range)
     Dim lnk As Object, ie As Object, doc As Object, i As Long, R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range, delAdr As String, LR As Long
     Set ie = CreateObject("InternetExplorer.Application")
     With ie
         .Visible = True
         .navigate sURL
         
         Do Until .readyState = 4: DoEvents: Loop
             Application.wait (Now() + TimeValue("00:00:5"))
             Set doc = ie.document
             .ExecWB 17, 0 '// SelectAll
             .ExecWB 12, 2 '// Copy selection
             .Quit
         End With
         Set ie = Nothing
         Application.Goto oDestination
         ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
         DisplayAsIcon:=False
         
         'Some of my code will be place here.
     End Sub

[parscon]

It was my mistake and your code 100% work . Thank you very much .

[parscon]

I found the problem just i must add Worksheets("Sheet1").Activate to end of my code .

Thank you very much . Really you save me .

Best Regards

[mancubus]

You mean like so:

exactly.