1.Liittäisin manuaalisesti URL osoitteen Sheet1 A1 soluun
http://heppa.hippos.fi/heppa/app?page=racing/RaceProgramOneRace&service=external&sp=CF1274302800000&sp=CEK&sp=CC1
2.Onko mahdollista tehdä jokin käsky että se hakisi osoitteen Sheet1 solusta A1 ja siirtäisi sen Makroon Sub Lähtö1A oikealle paikalle.
With ActiveSheet.QueryTables.Add(Connection:= _
"URL; .................................................", Destination:=Range("$A$1"))
Sub Lähtö1A()
Worksheets("Lähtö1").Select
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://heppa.hippos.fi/heppa/app?page=racing/RaceProgramOneRace&service=external&sp=CF1274302800000&sp=CEK&sp=CC1", Destination:=Range("$A$1"))
.Name = "lähtö_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingRTF
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
http://heppa.hippos.fi/heppa/app?page=racing/RaceProgramOneRace&service=external&sp=CF1274302800000&sp=CEK&sp=CC1
2.Onko mahdollista tehdä jokin käsky että se hakisi osoitteen Sheet1 solusta A1 ja siirtäisi sen Makroon Sub Lähtö1A oikealle paikalle.
With ActiveSheet.QueryTables.Add(Connection:= _
"URL; .................................................", Destination:=Range("$A$1"))
Sub Lähtö1A()
Worksheets("Lähtö1").Select
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://heppa.hippos.fi/heppa/app?page=racing/RaceProgramOneRace&service=external&sp=CF1274302800000&sp=CEK&sp=CC1", Destination:=Range("$A$1"))
.Name = "lähtö_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingRTF
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Vastaukset 1
Vanhimmat
Höö olin vähän tyhmä, niin tyhmä et sain tuhlattua pari päivää yksinkertaiseen asiaan.
Näin se haku tehdään Sheet1 A1 solusta ja osoite kopsaantuu sit sinne mihin se on tarkoitettu.
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("Sheet1!A1").Value, Destination:=Range("$A$1"))