Macro needs amendment to include loop

Dear all,

I have recently purchased login details to a specific website; as there are over 6000 entries in this list, it will take a long time to copy-paste all information on to a Word-file or something.
I have retrieved all individual URL's of each individual record; I have tried to let an Excel Macro / VBA run each individual link and copy/paste the information but this is not working.
The VBA I have tried to run is:

Sub Test()
 Dim IE As Object
 
Set IE = CreateObject("InternetExplorer.Application")
 With IE
 .Visible = True
 .Navigate "http://6000profiles.com/Alphabets/../Company%20profiles/A%20Different%20World.htm "
 Do Until .ReadyState = 4: DoEvents: Loop
 
x = .document.body.innertext
 x = Replace(x, Chr(10), Chr(13))
 x = Split(x, Chr(13))
 Range("A1").Resize(UBound(x)) = Application.Transpose(x)
 
.Quit
 End With
 
End Sub

In the above construction I need to manually amend the URL field about 6000 times.
I would like to make an adjustment where the VBA automatically goes thru the list of URL's I have in, lets say, Worksheet 1 and copies all relevant information all below eachother on, lets say, Worksheet 2.
Can anyone help me out ? I am completely stranded on this one.....

With many thanks, Marcel.

Welcome to the forum.

I have added code tags to your post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. If you need more information on how to use them, check my signature below this post.

@Marcel,

To be honest, being that this is a website that someone must pay to access and have a user/password its going to be hard for anyone to help.

Maybe this

Sub Test()
 Dim IE As Object
 
Set IE = CreateObject("InternetExplorer.Application")

 With IE
 For i = 1 To 10
 .Visible = True
                      'Cell that has link
 .Navigate "http://" & Cells(i, "a")
 Do Until .ReadyState = 4: DoEvents: Loop
 
    x = .document.body.innertext
    x = Replace(x, Chr(10), Chr(13))
    x = Split(x, Chr(13))
    Range("A" & Cells(Rows.Count).End(xlUp).Offset(1, 0)).Resize(UBound(x)) = Application.Transpose(x)
 Next i
.Quit
 End With
 
End Sub