Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Harte Nuss!?!? Makro Fehler überspringen!!





Frage

Hallo, Ich habe ein für mich großes Problem. Das folgende Makro geht in einen Ordner und kopiert Felder aus den im Ordner befindenden .xls Dateien. Wenn er mit einem fertig ist, dann geht er in die nächste Datei und macht das gleiche. Dadurch erhalte ich eine übersichtliche einzelne Datei. Das Problem ist, wenn jemand die Quelldatei offen hat, kann das makro nicht weiter machen und hört auf. gibt es eine Möglichkeit, bei solchen Fehlern einfach mit der nächsten Datei weiterzumachen? Würdet mir sehr helfen, wenn Ihr das auf dieses Makro anpassen könntet. Sub übersicht() Dim Mappen As Integer Dim zeile As Integer Dim Letztezeile As Integer Application.AskToUpdateLinks = False Application.DisplayAlerts = False With Application.FileSearch .NewSearch .LookIn = "C:\Geschäft" .SearchSubFolders = False .Filename = "*.xls" If .Execute() > 0 Then For Mappen = 1 To .FoundFiles.Count Workbooks.Open Filename:=.FoundFiles(Mappen) ActiveWindow.ScrollRow = 1 Sheets("Exec. Summary").Select Range("C5").Select Application.CutCopyMode = False Selection.Copy Windows("Test.xls").Activate Sheets("Gesamt").Select zeile = Range("A65536").End(xlUp).Row Range("A" & zeile + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks(2).Activate ActiveWindow.ScrollRow = 1 Sheets("Input Sheet").Select Range("C6").Select Application.CutCopyMode = False Selection.Copy Windows("Test.xls").Activate Sheets("Gesamt").Select zeile = Range("A65536").End(xlUp).Row Range("B" & zeile).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks(2).Close Next Mappen End If End With End Sub Vielen Dank

Antwort 1 von nostalgiker6

Das müsste doch mit dem guten alten "on error" gehen, wobei es wohl gut wäre, die erst Fehlerart zu klären.

Antwort 2 von Muster

Danke erstmal für diesen Tipp.
hab leider keine Ahnung wie man das einbauen kann?
Das Problem ist wenn ein anderer Benutzer im Netzwerk die Datei offen hat. Kann man die ja nur schreibgeschützt öffnen. Und um das zu entgehen. Da ich das Makro laufen lassen will, wenn ich nicht da bin. Will ich dass es nicht durch die Fragen "speichern ja nein" oder Aktualisieren wegen verknüpfungen oder sowas gestoppt wird.

Und vor allem dass es weiterläuft wenn jemand anderes eine von 800 Dateien offen hat.
Es soll dann einfach zur nächsten übergehen.

Danke!

Antwort 3 von coros

Hi Muster,

das sollte mit nachfolgendem Makro, in das die Änderung bereits mit eingearbeitet ist (Änderung habe ich Unterstrichen) funktionieren. Ich konnte es allerdings leider nicht testen, da ich keine Meinung habe, mir Deine Datei usw. nach zu bauen. Es wird lediglich über eine weitere For/ Each-Schleife geprüft, ob die Datei bereits geöffnet ist.

Sub übersicht()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer, Datei, Datei_vorhanden As Boolean
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count

For Each Datei In Workbooks
    If Datei.Name = .FoundFiles(Mappen) Then
    Datei_vorhanden = True
    Exit For
    End If
Next Datei

If vorhanden = True Then

Workbooks.Open Filename:=.FoundFiles(Mappen)

ActiveWindow.ScrollRow = 1
Sheets("Exec. Summary").Select
Range("C5").Select Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("A" & zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(2).Activate
ActiveWindow.ScrollRow = 1
Sheets("Input Sheet").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Workbooks(2).Close
End If
Next Mappen
End If
End With
End Sub


Man hätte auch mit einer „On Error Resume Next-Anweisung“ anstelle der Schleife arbeiten können. Aber Vorteil der Schleife, man könnte durch die Auswertung veranlassen, dass die Datei nicht mehr geöffnet werden muss, sondern man könnte dann sofort ab der Anweisung "ActiveWindow.ScrollRow = 1
" weitermachen lassen ohne dass die Workbooks.Open - Anweisung mit abgearbeitet werden muss.

Ich hoffe, meine Änderung funktioniert und dass Du klar kommst und alles verstanden hast. Ansonsten nachfragen bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von coros

Hi,

ich noch mal. Da hat sich beim kopieren der Variablen "Datei_vorhanden" ein kleiner Fehler eingeschlichen. Nachfolgend noch mal das richtige Makro.

Sub übersicht()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer, Datei, Datei_vorhanden As Boolean
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count

For Each Datei In Workbooks
    If Datei.Name = .FoundFiles(Mappen) Then
    Datei_vorhanden = True
    Exit For
    End If
Next Datei

If Datei_vorhanden = True Then

Workbooks.Open Filename:=.FoundFiles(Mappen)

ActiveWindow.ScrollRow = 1
Sheets("Exec. Summary").Select
Range("C5").Select Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("A" & zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(2).Activate
ActiveWindow.ScrollRow = 1
Sheets("Input Sheet").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Workbooks(2).Close
End If
Next Mappen
End If
End With
End Sub




MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.