Instabiles Excel Makro

[H.Manuel]

Hallo liebe Gemeinde,

ich habe ein kleines Problem, was auf Dauer ziemlich nervig ist.
Kurz vorab: Ich nutze MS Office 365 und habe mir eine Excel Tabelle mit einem Makro gebaut. In der Tabelle sollen automatisiert Aktienkurse und Fundamentaldaten abgefragt und ausgewertet werden.
Dazu habe ich in einem extra Reiter eine Liste erstellt mit den Links, die nacheinander aufgerufen werden sollen. Nach jedem einzelnen Aufruf extrahieren Formeln aus einem temporären Excel Blatt die entsprechenden Werte. Danach werden die Inhalte des temporären Blatts gelöscht und die nächste Abfrage startet. Und so geht das weiter bis alle Links durch sind.

Das Makro stürzt aber bei 4 von 5 Fällen ab. Excel reagiert nicht mehr und ich muss neu starten. Ab und zu geht alles glatt. 
Wenn das Makro abstürzt, dann nicht immer an der gleichen Stelle.

Ich vermute, dass ich irgendwas rein programmiert habe, was auch einfacher gelöst werden kann und v.a. stabiler.
Auch hatte ich mal vermutet, dass die Website meine Anfragen ggf. sperrt, weshalb ich es mit Pausen zwischen den einzelnen Abfragen von bis zu 60 Sekunden versucht habe. Das Resultat war aber das gleiche :(

Was mir noch aufgefallen ist: Wenn ich neben der Ausführung des Makros parallel am Rechner arbeite oder surfe, dann scheint die Absturzrate der Makros sehr viel geringer zu sein. Vielleicht bilde ich es mir auch nur ein, oder vielleicht ist das ein Indiz für irgendeinen Fehler .... 

Da ich nicht so erfahren mit Makros bin hoffe ich, dass mir hier jemand helfen kann.

Danke schon einmal an alle, die sich das ansehen!!

Liebe Grüße
Manuel

Das Makro sieht folgendermaßen aus:

Code:

Sub Makro1()
'
'
   Sheets("Fundamentalliste").Select
   ActiveSheet.Rows("2:9999").Delete
   
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 = Worksheets("LINKS_Bilanzen")
 With wksListeLinks
   lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
 End With
 
     
 Set wbZiel = ActiveWorkbook
 Set wksZiel = Worksheets("Webabfrage")
 


 
 For lngZeile = 2 To lngZeile 'Startzeile der Liste ggf. anpassen!
   iCount = iCount + 1

   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

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime


   Call WerteKopieren
   
   Worksheets("Webabfrage").UsedRange.ClearContents
   
 Next lngZeile
End Sub

Code:

Sub WerteKopieren()
'
' WerteKopieren Makro
'

   Sheets("TMP_Datenauslese").Select
   ActiveSheet.Rows("2:2").Select
   Selection.Copy
   Sheets("Fundamentalliste").Select
   Cells(65000, 1).End(xlUp).Offset(1, 0).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("TMP_Datenauslese").Select
   ActiveSheet.Rows("4:4").Select
   Application.CutCopyMode = False
   Selection.Copy
   Sheets("Fundamentalliste").Select
   Cells(65000, 1).End(xlUp).Offset(1, 0).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Application.CutCopyMode = False
End Sub

[MisterBurns]

Hallo Manuel,

ich kann dein Problem leider nicht lösen, kann dir aber zumindest mal dein Makro "WerteKopieren" geringfügig kürzen:

Code:

Sub WerteKopieren()
Sheets("TMP_Datenauslese").Range("2:2,4:4").Copy
Sheets("Fundamentalliste").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

Du schreibst, dass dein Makro nicht immer an derselben Stelle abstürzt. Aber an welchen Stellen kann denn dies passieren?

BTW: Arbeiten Fundamentalisten eigentlich mit Fundamentallisten? :24:

[Gast 123]

Hallo

weil es heisst das immer wieder Fehler auftreten ist es gut ihn einzugrenzen.  Ich habe das Makro des Kollegen um eine Fehler Routine erweitert.  In Makro1 kann man auch den Fehler abfangen, über Msgbox anzeigen lassen.  Dann weiss man im Fehlerfall welches Makros betroffen ist, kann gezielt weitersuchen.

mfg  Gast 123

Code:

Sub WerteKopieren()
On Error GoTo Fehler2:
Sheets("TMP_Datenauslese").Range("2:2,4:4").Copy
Sheets("Fundamentalliste").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
Fehler2:  MsgBox "Fehler in Werte kopieren aufgetreten!!" & Chr(10) & Error()
End Sub

Für Makro1 On Error Goto vor die Set Anweisung.  Und Fehler1 hinter Next IngZeile mit "Exit Sub"

Code:

'Für Makro1  Fehler Code:
On Error GoTo Fehler1
Set wksListeLinks = Worksheets("LINKS_Bilanzen")
 
  '******  hier das normales Programm  ********

Next lngZeile
Exit Sub
Fehler1:  MsgBox "Fehler in Makro1 aufgetreten!!" & Chr(10) & Error()
End Sub

[H.Manuel]

Hallo,

erstmal Danke für die Antworten. Das Kopieren Makro habe ich entsprechend gekürzt, merci ;)

Also die Stelle des absturzes ist unterschiedlich, das stimmt....aber jedes Mal wenn sich das Ding aufhängt, dann steht unten rechts "Verbinde zum Web"....Ich schätze also, dass es das Abfrage-Makro ist, welches den Fehler verursacht.
Schlauer macht mich das leider nur bedingt :(

[Gast 123]

Hallo

nicht so schnell aufgeben, hartnaeckig bleiben.  Mit etwas Glück finden wir den Fehler...  Schau mal hier nach:
strLink = wksListeLinks.Cells(lngZeile, 1)  

Steht in deiner Liste in der Zelle immer ein Wert??  Kann da auch mal eine leere Zelle dazwischen sein??   Oder ein Wert wo es im Internet keinen gültigen URL Link zu gibt??  Kannst du dir diese Liste mal bitte ganz genau ansehen.

mfg  Gast 123