Sub test()
Dim Spalte As Integer
Dim startzeile As Integer
Dim endzeile As Integer
Dim numberws As Integer
On Error GoTo Fehler
Tabellenblatt = InputBox("Name des Tabellenblattes in der sich die Aktienkürzel von finance.yahoo.de befinden")
Spalte = InputBox("Nummer der Spalte in der sich die Aktienkürzel von finance.yahoo.de befinden")
startzeile = InputBox("Startzeilenummer der Aktienkürzel")
endzeile = InputBox("Endzeile der Aktienkürzel")
For n = startzeile To endzeile
x = Worksheets(Tabellenblatt).Cells(n, Spalte).Value
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
, Destination:=Range("$A$1"))
.Name = "table.csv?s=BMW.DE&d=6&e=31&f=2012&g=d&a=0&b=1&c=2003&ignore="
.FieldNames = True
.RowNumbers = True
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = x
ActiveWorkbook.Connections("table.csv?s=" & x & "&d=" & Month(Date) & "&e=" & Day(Date) & "&f=" & Year(Date) & "&g=d&a=0&b=1&c=1900&ignore=").Delete
ActiveSheet.QueryTables.Item(ActiveSheet.QueryTables.Count).Delete
ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(1, 7).End(xlDown)), , xlYes).Name = x
MsgBox "Die Kurse für " & x & " wurden erfolgreich in ein neues Tabellenblatt geladen."
Next n
Hier beginnt der Code meines VBA-Tools, bzw. was ich jetzt habe
Option Explicit
Option Base 1
Sub Test()
Dim wb As Workbook: Set wb = Workbooks("Gruppenassignment.xlsm")
Dim wsBMW As Worksheet: Set wsBMW = wb.Worksheets("BMW")
Dim wsBASF As Worksheet: Set wsBASF = wb.Worksheets("BASF")
Dim wsRWE As Worksheet: Set wsRWE = wb.Worksheets("RWE")
Dim i As Integer, j As Integer, k As Integer
Dim letzteZeileBMW As Long: letzteZeileBMW = wsBMW.Cells(2, 6).End(xlDown).Row
Dim lZBASF As Long: lZBASF = wsBASF.Cells(2, 6).End(xlDown).Row
Dim lZRWE As Long: lZRWE = wsRWE.Cells(2, 6).End(xlDown).Row
For i = 1 To letzteZeileBMW
With wsBMW
If .Cells(i, 6) = "0" Then
.Rows(i).Delete
End If
End With
Next i
For j = 1 To lZBASF
With wsBASF
If .Cells(j, 6) = "0" Then
.Rows(j).Delete
End If
End With
Next j
For k = 1 To lZRWE
With wsRWE
If .Cells(k, 6) = "0" Then
.Rows(k).Delete
End If
End With
Next k
End Sub