AW: Wertübertragung ?
22.02.2015 15:34:53
unzzz1978
Hallu Luschi,
danke für deine Antwort. Wie ich sehen konnte funktioniert dein Code hervorragend und man hat mich verstanden(war mir nicht klar).
Könntest du deinen Code auch in meinen integrieren? Habe da so meinen Probleme!!! Man kann auch an meinen Code gut erkennen, daß ich ein absoluter Leie auf diesem Gebiet bin ;(
Danke für deine Hilfe und Unterstützung !
Grüße
unzzz1978
Sub update_components()
' update_dax_components Makro
' lädt die neusten kürzel von finance.yahoo.com
' SuchenErsetzen()
Worksheets("DAX").range("AF:AF").Replace " ", "_"
Sheets("DAX").Select
range("AF8:AP8").Select
Selection.Delete Shift:=xlUp
range("AF9:AP9").Select
Selection.Delete Shift:=xlUp
range("AF10:AP10").Select
Selection.Delete Shift:=xlUp
range("AF11:AP11").Select
Selection.Delete Shift:=xlUp
range("AF12:AP12").Select
Selection.Delete Shift:=xlUp
range("AF13:AP13").Select
Selection.Delete Shift:=xlUp
range("AF14:AP14").Select
Selection.Delete Shift:=xlUp
range("AF15:AP15").Select
Selection.Delete Shift:=xlUp
range("AF16:AP16").Select
Selection.Delete Shift:=xlUp
range("AF17:AP17").Select
Selection.Delete Shift:=xlUp
range("AF18:AP18").Select
Selection.Delete Shift:=xlUp
range("AF19:AP19").Select
Selection.Delete Shift:=xlUp
range("AF20:AP20").Select
Selection.Delete Shift:=xlUp
range("AF21:AP21").Select
Selection.Delete Shift:=xlUp
range("AF22:AP22").Select
Selection.Delete Shift:=xlUp
range("AF23:AP23").Select
Selection.Delete Shift:=xlUp
range("AF24:AP24").Select
Selection.Delete Shift:=xlUp
range("AF25:AP25").Select
Selection.Delete Shift:=xlUp
range("AF26:AP26").Select
Selection.Delete Shift:=xlUp
range("AF27:AP27").Select
Selection.Delete Shift:=xlUp
range("AF28:AP28").Select
Selection.Delete Shift:=xlUp
range("AF29:AP29").Select
Selection.Delete Shift:=xlUp
range("AF30:AP30").Select
Selection.Delete Shift:=xlUp
range("AF31:AP31").Select
Selection.Delete Shift:=xlUp
range("AF32:AP32").Select
Selection.Delete Shift:=xlUp
range("AF33:AP33").Select
Selection.Delete Shift:=xlUp
range("AF34:AP34").Select
Selection.Delete Shift:=xlUp
range("AF35:AP35").Select
Selection.Delete Shift:=xlUp
range("AF36:AP36").Select
Selection.Delete Shift:=xlUp
range("AF37:AP37").Select
Selection.Delete Shift:=xlToLeft
range("A1").Select
'excel
For i = 1 To 1 Step 1
On Error GoTo Fehler:
stock = Worksheets("DAX").Cells(i + 6, 2).Value
numberws = Worksheets.Count
' schon bestehende Tabellenblätter mit dem gleichen Namen werden gelöscht
For n = numberws To 1 Step -1
If Worksheets(n).Name = stock Then
Application.DisplayAlerts = False
Worksheets(n).Delete
Application.DisplayAlerts = True
End If
Next n
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = stock
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finanzen.net/bilanz_guv/" & stock, Destination:=range _
("$A$1"))
.Name = stock
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5,6,7,8,9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Cells.Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.finanzen.net/termine/" & stock, Destination:=range("$A$46"))
.Name = "stock"
.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 = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.finanzen.net/schaetzungen/" & stock, Destination:=range("$J$1" _
))
.Name = "stock"
.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 = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.finanzen.net/Kursziele/" & stock, Destination:=range("$J$32"))
.Name = "stock"
.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
range("AQ7").Select
Selection.Copy
Sheets("adidas").Select
range("A56").Select
ActiveSheet.Paste
Dim mydate1 As Date
mydate1 = [C47]
[A58] = Month(mydate1)
[A57] = Day(mydate1)
[A59] = Year(mydate1)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://de.finance.yahoo.com/q/hp?s=ADS.DE" & "b=" & range("A57") & "a=" & range(" _
A58") & "c=" & range("A59") & "e=" & range("A57") & "d=" & range("A58") & "f=" & range("A59") & g = d _
, Destination:=range("$C$61"))
.Name = Yahoo
.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 = "15"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next i
' Testen ob es mindestens 4 Arbeitsblätter
' in der Mappe gibt und ...
If Sheets.Count