Sub Macro2()
a = 1
Sheets(3).Select
While Sheets(1).Cells(a, 1) <> ""
urladdress = "URL;" & Sheets(1).Cells(a, 1).Text
With ActiveSheet.QueryTables.Add(Connection:= _
urladdress, Destination:=Range( _
"$A$1"))
.Name = Right(Sheets(1).Cells(a, 1).Value, 80)
.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
'.WebTables = "1,""wedstrijdTable2"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("a26").Copy Sheets(2).Cells(a, 1)
Range("b26").Copy Sheets(2).Cells(a, 2)
Range("a27").Copy Sheets(2).Cells(a, 3)
Range("b27").Copy Sheets(2).Cells(a, 4)
Range("a28").Copy Sheets(2).Cells(a, 5)
Range("b28").Copy Sheets(2).Cells(a, 6)
Range("a29").Copy Sheets(2).Cells(a, 7)
Range("b29").Copy Sheets(2).Cells(a, 8)
Range("a30").Copy Sheets(2).Cells(a, 9)
Range("b30").Copy Sheets(2).Cells(a, 10)
Range("a31").Copy Sheets(2).Cells(a, 11)
Range("b31").Copy Sheets(2).Cells(a, 12)
Range("a32").Copy Sheets(2).Cells(a, 13)
Range("b32").Copy Sheets(2).Cells(a, 14)
Range("a33").Copy Sheets(2).Cells(a, 15)
Range("b33").Copy Sheets(2).Cells(a, 16)
Range("a34").Copy Sheets(2).Cells(a, 17)
Range("b34").Copy Sheets(2).Cells(a, 18)
Range("a35").Copy Sheets(2).Cells(a, 19)
Range("b35").Copy Sheets(2).Cells(a, 20)
Range("a36").Copy Sheets(2).Cells(a, 21)
Range("b36").Copy Sheets(2).Cells(a, 22)
Range("a37").Copy Sheets(2).Cells(a, 23)
Range("b37").Copy Sheets(2).Cells(a, 24)
Range("a38").Copy Sheets(2).Cells(a, 25)
Range("b38").Copy Sheets(2).Cells(a, 26)
Range("a39").Copy Sheets(2).Cells(a, 27)
Range("b39").Copy Sheets(2).Cells(a, 28)
Range("a40").Copy Sheets(2).Cells(a, 29)
Range("b40").Copy Sheets(2).Cells(a, 30)
Range("a41").Copy Sheets(2).Cells(a, 31)
Range("b41").Copy Sheets(2).Cells(a, 32)
Range("a42").Copy Sheets(2).Cells(a, 33)
Range("b42").Copy Sheets(2).Cells(a, 34)
Range("a43").Copy Sheets(2).Cells(a, 35)
Range("b43").Copy Sheets(2).Cells(a, 36)
Range("a44").Copy Sheets(2).Cells(a, 37)
Range("b44").Copy Sheets(2).Cells(a, 38)
Range("a45").Copy Sheets(2).Cells(a, 39)
Range("b45").Copy Sheets(2).Cells(a, 40)
a = a + 1
Sheets(3).Cells.ClearContents
Wend
End Sub
Then Run the macro. in 2003 it will work fine. but in 2010 not responding.
Bookmarks