ich möchte mehrere CSV-Dateien aus dem Internet herunterladen und auf dem aktuellen Tabellenblatt untereinander ab der Zeile "A4" auflisten. Das geht soweit, jedoch werden zur Zeit die Dateien nebeneinander aufgelistet. Also erste Datei A4:B4, zweite Datei C4:D4. Außerdem wird ein Text oberhalb von A4 verschoben. Danke für die Hilfe im Voraus.
Public Function URLEncode(StringToEncode As String, Optional _
UsePlusRatherThanHexForSpace As Boolean = False) As String
Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
Select Case Asc(Mid$(StringToEncode, CurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
TempAns = TempAns & Mid$(StringToEncode, CurChr, 1)
Case 32
If UsePlusRatherThanHexForSpace = True Then
TempAns = TempAns & "+"
Else
TempAns = TempAns & "%" & Hex(32)
End If
Case Else
TempAns = TempAns & "%" & Hex(Asc(Mid$(StringToEncode, _
CurChr, 1)))
End Select
CurChr = CurChr + 1
Loop
URLEncode = TempAns
End Function
Sub Import_Allianzen()
' Import Allianzdateien
Dim strTxt As String
Dim strVerz As String
Dim strDat As String
Dim strName As String
Dim strUrl As String
Dim strCon As String
Dim strAnzRow As String
strTxt = "TEXT;"
'strVerz = 'Range("B5") = Verzeichnis oder https://lakkt.de/de/function/downloadCSV.php?link=
strVerz = "https://lakkt.de/de/function/downloadCSV.php?link="
strAnf = "A4" 'Anfang Spieler 1
strEnd = "Z65000" 'Ende Spieler
'Alles löschen
Cells(65000, 1).End(xlUp).Offset(1, 0).Select
Range(strAnf & ":" & strEnd).Delete xlToLeft
Dim lAnzahl As String
Dim i As Long
Dim a As Long
Anf:
lAnzahl = 2 'Worksheets("Daten BNDnisse gesamt").Range("G5") 'InputBox("Wie oft soll das Makro _
_
laufen ?", , 3)
If lAnzahl = "" Then Exit Sub
i = 1
If IsNumeric(lAnzahl) Then
For i = 1 To CLng(lAnzahl)
'Allianzlink, strDat = "l+k//alliance?929&169"
a = "6" + i
strDat = Worksheets("Daten BNDnisse gesamt").Range("B" & a) 'B7 = Anfang
'Bündnisname
strName = Worksheets("Daten BNDnisse gesamt").Range("A" & a) 'Name
MsgBox strName, vbInformation
'strUrl = l%2Bk%3A%2F%2Falliance%3F929%26169&type=player
strUrl = URLEncode(strDat)
'strCon = https://lakkt.de/de/function/downloadCSV.php?link=l%2Bk%3A%2F%2Falliance%3F929%26169& _
_
type=player
strCon = strTxt & strVerz & strUrl & "&type=player"
With ActiveSheet.QueryTables.Add(Connection:=strCon, Destination:=Range(strAnf))
.Name = strName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "Bitte ein Zahl eingeben !", vbInformation
GoTo Anf
End If
'leerzeilen löschen
Dim LgRow As Long
For LgRow = Cells(Rows.Count, 5).End(xlUp).Row To 5 Step -1
If Cells(LgRow, 1) = "" Then Rows(LgRow).Delete
Next
End Sub