---

Jeg arbejder på at trække data fra denne hjemmeside:
http://www.toyodiy.com/parts/xref?s=

På hjemmeside kan reservedelsnumre slåes op. Et eksempel kunne være 47771-32010. Resultatsiden for søgningen findes på den nævnte URL+det reservedelsnummer man vil søge på - Eksempelvis: http://www.toyodiy.com/parts/xref?s=47771-32010

På siden fremkommer en tabel med følgende kolonner:
Date range    Model   Frames/Options   Found in diagram

Jeg vil gerne trække tabellens informationer over i Excel hvor jeg kan sortere og søge i data.
Jeg kan sagtens gøre dette ved hjælp af funktionen "Data --> Fra internettet" i excel. Men her gør jeg det for et reservedelsnummer. Jeg kunne godt tænke mig at have en kolonne med reservedelsnumre som den så automatisk søger op når jeg klikker på en knap.

Jeg har kigget en del på nettet/youtube, men ikke lige fundet løsningen. Jeg forestiller mig noget med at første ark indeholder listen med reservedelsnumre (kolonne A) og en beskrivelse (kolonne B) og at resultatet vises i ark 2.

På ark to kunne jeg godt tænke mig at resultatet blev vist efter dette format:
Kolonne A: Reservedelsnummer (fra ark 1)
Kolonne B: Beskrivelse (fra ark 1)
Kolonne C: Date range (fra webside)
Kolonne D: Model (fra webside)
Kolonne E: Frame/Option (fra webside)
Kolonne F: Found in diagram (fra webside)

Da der er stor forskel på antallet af rækker der returneres fra en søgning, vil jeg gerne have reservedelsnummer og bekrivelse (Kolonne A og B) med hele vejen ned på alle de rækker der høre til den enkelte søgning.
Sidst men ikke mindst vil jeg gerne have alle resultater i samme ark og lige efter hinanden.

Er der nogen der kan lede mig i den rigtige retning? På forhånd tak!

Jeg ved dette er et svært spørgsmål, men jeg har desværre ikke flere point. :)

---

Pointene er ikke afgørende. Det er i hvert fald en lidt spændende opgave.
Forstår jeg rigtig at du ønsker ud fra et reservedels nummer i Excel, som du klikker på så få en liste hentet ind i Excel fra hjemmesiden, lignende den du linker til?
Umiddelbart vil jeg mene at du bør importere hele reservedels-kataloget far hjemmesiden, og så lave det i Excel som du ønsker, det kræver jo så blot en jævnlig opdatering.
Denne funktion kunne jeg da godt tænke mig at vide lidt mere om, hvor finder du den på båndet?

Hvis vi antager at du har en celle med reservedels-nummeret, vil jeg mene du skal lægge denne url: http://www.toyodiy.com/parts/xref?s= sammen med reservedelsnummeret, og lave den til et link, som henter data. Det må være første skridt? Og jeg tror ikke det kan lade sig gøre uden der skal programmeres noget makro, og det er ikke lige mit special område.
Jeg e rikke helt hundrede med på hvad du præcis ønsker, selv om du har beskrevdet der temmelig nøjagtig. Du skal nok have en ind over der er skrap til VBA i Excel.

---

Jeg vil gerne have at jeg kan sætte en kolonne ind med reservedelsnumre (ca 500 stk). Når jeg så køre en makro (eller hvad det nu er der skal til), så henter den data fra hjemmesiden for alle disse 500 reservedelsnumre. Det kan også være en lidt mere manuel metode, hvor jeg når jeg har tasted reservedelsnummeret, klikker på en knap eller noget, og derved henter data for dette nummer.
For mig er det mest afgørende i denne situation at den automatisk tilføjer de hentede data til et ark så jeg ikke selv skal klippe/kopiere til og fra ark og samle sammen.

---

Jeg finder i øvrigt funktionen i båndet under "Data" --> "Hent eksterne data" --> "Fra internettet"

---

Så langt så godt. Nu har jeg lavet det sådan at den slår op 5 gange (i felterne har jeg det fulde URL - sammensat af førstnævnte URL og et reservedelsnummer) og indsætter data på arket "Samlet". Men den smider bare data ind efter hinanden ud af i kolonnerne. Så første opslag står i række 2 kolonne B-E, næste opslag står i række 2 kolonne F-I osv...

Jeg vil hellere have alle resultater i kolonne B-E og så kommer de enkelte opslag under hinanden i rækkerne. Jeg lurer på om jeg kan lave noget med at sætte Range til "Kolonne: B, Række: Næste tomme række".

Nogen der kan hjælpe med det?

Her er koden indtil nu:

Sub adds()
For x = 1 To 5
Worksheets("Ark1").Select
Worksheets("Ark1").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub

---

Det er nu lykkedes. Min kode blev:
Sub adds()

Worksheets("Samlet").Select
Worksheets("Samlet").Activate
ActiveSheet.Cells.Clear

For x = 1 To 5
Worksheets("Input").Select
Worksheets("Input").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Range("A2").Select
Rows("1:20").Insert Shift:=xlDown
ActiveWorkbook.Sheets("Samlet").Range("A1").Value = mystr

With Sheets("Samlet").Range("A1")
If Left(.Value, 1) = "U" Then .Value = Right(.Value, Len(.Value) - 40)
End With

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

Next x

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"



Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Columns("A").ColumnWidth = 15
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 39
Columns("E").ColumnWidth = 47

End Sub


På "input" angiver jeg stien til den tabel jeg ønsker for en bestemt reservedel.
På "samlet" kommer resultatet ud.

---

Jeg har desværre ikke modtaget et gyldigt svar, og annullerer derfor dette spørgsmål

Jeg kom dog selv frem til denne kode:
Sub adds()

Worksheets("Samlet").Select
Worksheets("Samlet").Activate
ActiveSheet.Cells.Clear

For x = 1 To 5
Worksheets("Input").Select
Worksheets("Input").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Range("A2").Select
Rows("1:20").Insert Shift:=xlDown
ActiveWorkbook.Sheets("Samlet").Range("A1").Value = mystr

With Sheets("Samlet").Range("A1")
If Left(.Value, 1) = "U" Then .Value = Right(.Value, Len(.Value) - 40)
End With

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

Next x

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"



Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Columns("A").ColumnWidth = 15
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 39
Columns("E").ColumnWidth = 47

End Sub

Dette spørgsmål er blevet annulleret, det er derfor ikke muligt for at tilføje flere kommentarer.