Werte in Zeilen statt Tabellenblättern ausgeben
27.02.2014 08:47:45
Tobias
ich habe folgendes Skript übernommen das mir die Arbeit sehr erleichtert.
Es werden die einzelnen ausgelesenen Werte jeweils als neues Tabellenblatt ausgegeben. Dies ist jedoch nur bis zu einer gewissen Anzahl interessant und gut. Wie kann ich die Ausgabe so ändern, dass anstatt eines neuen Tabellenblatts für jeden ausgelesenen Wert eine neue Zeile in Tabellenblatt 2 genutzt wird. Irgendwie finde ich dafür nicht wirklich den richtigen Ansatz - leider.
Jetzt:
Eintrag 2 = Tabellenblatt 2
Eintrag 3 = Tabellenblatt 3
...
Gewünscht:
Eintrag 2 = Tabellenblatt 2 Zeile 2
Eintrag 3 = Tabellenblatt 2 Zeile 3
usw.
Hoffe dies verdeutlicht mein Anliegen.
Danke bereits im Vorfeld
Sub IE()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strCon As String
Dim wbZiel As Workbook, wksZiel As Worksheet, iCount As Integer
Dim strName As String
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For lngZeile = 1 To lngZeile
iCount = iCount + 1
If wbZiel Is Nothing Then
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
Else
Set wksZiel = wbZiel.Worksheets.Add(after:=wksZiel)
End If
strLink = wksListeLinks.Cells(lngZeile, 1)
strCon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strCon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.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
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If iCount = 10 Then
iCount = 0
Set wbZiel = Nothing
End If
Next lngZeile
End Sub