Supportnet / Forum / Tabellenkalkulation
Makro anpassen!!!!????
Frage
Hi,
Dieses Makro geht in den Ordner und öffenet alle Exel Dateien die sich da befinden und kopiert 2 Zellen und macht für ca. 300 Dateien.
Aber ab und zu will ich nicht alle 300 Dateien zusammenfassen.
gibt es eine Möglichkeit, dass ich im Tabellenblatt "Daten" In Spalte A ab zeile 3 die Dateinamen schreibe, die er öffnen soll. Und das Makro läuft nur über die Dateien?
Wäre super wenn sich ein Experte findet der mir da hilft!!
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
ActiveWindow.ScrollRow = 1
Sheets("Tabelle1").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").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("Tabelle2").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Activepage.Save
Next Mappen
End If
End With
End Sub
Danke
Antwort 1 von fürLau
Hallo
Nachdem Du mit dem speziell nach Deinen Angaben, von mir geschrieben Code nich klargekommen bist, hier also Dein "angepasstes Makro":
Gruß
Nachdem Du mit dem speziell nach Deinen Angaben, von mir geschrieben Code nich klargekommen bist, hier also Dein "angepasstes Makro":
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letzezeile = Range("a65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:" & CStr(Letztezeile)) ´ neu dazu gekommen
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
End With ´neu dazu gekommen
If c = Nothing Then GoTo naechster ´ neu dazu gekommen
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
ActiveWindow.ScrollRow = 1
Sheets("Tabelle1").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").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("Tabelle2").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Activepage.Save
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
Gruß
Antwort 2 von nighty
hi all
auf die schnelle
gruss nighty
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
Dim zelle As Range
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
Set Mappennamen = Range("A3:A5")
For Each zelle In Mappennamen
Workbooks.Open Filename:="C:\Temp\" & zelle & ".xls"
Application.Calculate
ActiveWindow.ScrollRow = 1
Sheets("Tabelle1").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").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("Tabelle2").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Activepage.Save
Next zelle
End Sub
auf die schnelle
gruss nighty
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
Dim zelle As Range
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
Set Mappennamen = Range("A3:A5")
For Each zelle In Mappennamen
Workbooks.Open Filename:="C:\Temp\" & zelle & ".xls"
Application.Calculate
ActiveWindow.ScrollRow = 1
Sheets("Tabelle1").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").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("Tabelle2").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Activepage.Save
Next zelle
End Sub
Antwort 3 von fürLau
Antwort 4 von Fragenkatalog
Hallo für Lau,
bin grad drüber deine Lösung auszuprobieren. aber hab da irgend ein Fehler gefunden. Sonst finde ich es genieal, danke für die Hilfe aber ich kann es nicht laufen lassen. Beim Start hat er einen Fehler bei Nothing then goto..
was kann das sein??
Danke
bin grad drüber deine Lösung auszuprobieren. aber hab da irgend ein Fehler gefunden. Sonst finde ich es genieal, danke für die Hilfe aber ich kann es nicht laufen lassen. Beim Start hat er einen Fehler bei Nothing then goto..
was kann das sein??
Danke
Antwort 5 von CaroS
Hallo fürLau,
finde folgende Stelle in Deinem Code (AW1) verdächtig:
With Range("A3:" & CStr(Letztezeile)) ´ neu dazu gekommen
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
End With ´neu dazu gekommen
If c = Nothing Then GoTo naechster ´ neu dazu gekommen
Tippe auf
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
Vielleicht verschwindet dann auch der Fehler in AW4.
Gruß,
CaroS
finde folgende Stelle in Deinem Code (AW1) verdächtig:
With Range("A3:" & CStr(Letztezeile)) ´ neu dazu gekommen
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
End With ´neu dazu gekommen
If c = Nothing Then GoTo naechster ´ neu dazu gekommen
Tippe auf
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
Vielleicht verschwindet dann auch der Fehler in AW4.
Gruß,
CaroS
Antwort 6 von Fragenkatalog
Hallo Caros und alle anderen,
also habe es umgetauscht aber der markiert mir wenn ich das Makro laufen lassen will immer noch das Nothing
und dann steht da ein Box mit :"Fehler beim Kompilieren:
Unzulässige Verwendung eines Objekts.
Kann mir da jemand helfen.
Sub Zusammenfassung()
Dim Mappen As Integer
Dim Zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("a65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
End With ´neu dazu gekommen
If c = Nothing Then GoTo naechster ´ neu dazu gekommen
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
Workbooks(2).Close
Activepage.Save
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
also habe es umgetauscht aber der markiert mir wenn ich das Makro laufen lassen will immer noch das Nothing
und dann steht da ein Box mit :"Fehler beim Kompilieren:
Unzulässige Verwendung eines Objekts.
Kann mir da jemand helfen.
Sub Zusammenfassung()
Dim Mappen As Integer
Dim Zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("a65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
End With ´neu dazu gekommen
If c = Nothing Then GoTo naechster ´ neu dazu gekommen
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
Workbooks(2).Close
Activepage.Save
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
Antwort 7 von CaroS
Hallo Fragenkatalog, hallo fürLau,
vermute, dass es an einem fehlenden kleinen s liegt (2 Zeilen oberhalb von If c = Nothing):
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
c = .Find(.foundfiles(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
Im allgemeinen fummle ich nicht so gern in fremdem Code rum, aber wenn´s (ihn) schön macht ...
Gruß,
CaroS
vermute, dass es an einem fehlenden kleinen s liegt (2 Zeilen oberhalb von If c = Nothing):
c = .Find(.foundfile(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
c = .Find(.foundfiles(Mappen), LookIn:=xlValues) ´ neu dazu gekommen
Im allgemeinen fummle ich nicht so gern in fremdem Code rum, aber wenn´s (ihn) schön macht ...
Gruß,
CaroS
Antwort 8 von fürLau
Hallo CaroS, Fragenkatalog
@CaroS, das war nur einer der Fehler (-:
Neuer Versuch, vielleicht klappt´s so:
Gruß
@CaroS, das war nur einer der Fehler (-:
Neuer Versuch, vielleicht klappt´s so:
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
Dim Name As String ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("A65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
Name = Mid(Application.FileSearch.FoundFiles(Mappen), _
Len(Range("D1").Value) + 1, _
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommen
Set c = .Find(Name, LookIn:=xlValues) ´ neu dazu gekommen
End With ´ neu dazu gekommen
If c Is Nothing Then GoTo naechster ´ neu dazu gekommen und geändert
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
ActiveWindow.ScrollRow = 1
Sheets("Tabelle1").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").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("Tabelle2").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Zusammen.xls").Activate
Sheets("Roll-Up").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
ActiveSheet.Save
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
Gruß
Antwort 9 von Fragenkatalog
Hallo an alle, die sich hier in die Sache mit eingeschalten haben.
ich bewundere euch ja schon, dass Ihr überhaupt da so gut auskennt.
Ich habe jetzt das neue Makro einkopiert und dann gestartet.
Habe davor mit einem anderen Makro die Dateinamen von dem Pfad in die Spalte a3bis a... kopiert.
Aber wenn ich das Makro dann starte und geht es aber nicht.
Es läuft durch und
geht bis zu fogenden Zeile:
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
Dim Name As String ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("A65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
Name = Mid(Application.FileSearch.FoundFiles(Mappen), _
Len(Range("D1").Value) + 1, _
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommen
Set c = .Find(Name, LookIn:=xlValues) ´ neu dazu gekommen
End With ´ neu dazu gekommen
If c Is Nothing Then GoTo naechster ´ neu dazu gekommen und geändert
dann spingt er weiter zu
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
wieso läuft das makro nicht.. wieso geht es nicht in meine Datein und kopiert die Zellen??
Woran könnte es liegen??
Ich habe in eine Blatt Daten den Pfad und auch die Dateinamen stehen...
Woran kann es noch liegen?
Gruß
ich bewundere euch ja schon, dass Ihr überhaupt da so gut auskennt.
Ich habe jetzt das neue Makro einkopiert und dann gestartet.
Habe davor mit einem anderen Makro die Dateinamen von dem Pfad in die Spalte a3bis a... kopiert.
Aber wenn ich das Makro dann starte und geht es aber nicht.
Es läuft durch und
geht bis zu fogenden Zeile:
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´ geändert
Dim c As Range ´ neu dazu gekommen
Dim Name As String ´ neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("A65535").End(xlUp).Row ´ neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´ neu dazu gekommen
Name = Mid(Application.FileSearch.FoundFiles(Mappen), _
Len(Range("D1").Value) + 1, _
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommen
Set c = .Find(Name, LookIn:=xlValues) ´ neu dazu gekommen
End With ´ neu dazu gekommen
If c Is Nothing Then GoTo naechster ´ neu dazu gekommen und geändert
dann spingt er weiter zu
naechster: ´neu dazu gekommen
Next Mappen
End If
End With
End Sub
wieso läuft das makro nicht.. wieso geht es nicht in meine Datein und kopiert die Zellen??
Woran könnte es liegen??
Ich habe in eine Blatt Daten den Pfad und auch die Dateinamen stehen...
Woran kann es noch liegen?
Gruß
Antwort 10 von fürLau
Hallo nochmal
Ich bin davon ausgegangen - wie weiter oben beschrieben - daß in der Zelle [D1] der Pfad zu den Dateien (z.B. "c:\Eigene Dateien\ ")steht. Weiterhin davon daß im Bereich A3:Ax die Dateinamen und zwar ohne den suffix ( .xls )stehen.
Damit hat es zumindest bei mir dann funktioniert.
Gruß
Ich bin davon ausgegangen - wie weiter oben beschrieben - daß in der Zelle [D1] der Pfad zu den Dateien (z.B. "c:\Eigene Dateien\ ")steht. Weiterhin davon daß im Bereich A3:Ax die Dateinamen und zwar ohne den suffix ( .xls )stehen.
Damit hat es zumindest bei mir dann funktioniert.
Gruß
Antwort 11 von Fragenkatalog
Hallo,
wäre es ein großes Problem wenn ich die Dateinamen mit xls stehen lassen würde??
oder reicht es wenn ich hier
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommen
das .xls weg mache.
Danke
wäre es ein großes Problem wenn ich die Dateinamen mit xls stehen lassen würde??
oder reicht es wenn ich hier
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommen
das .xls weg mache.
Danke
Antwort 12 von fürLau
hi,
Nein das reicht nicht, ersetze das statement:
durch:
dann sollte es klappen
Gruß
Nein das reicht nicht, ersetze das statement:
Zitat:
Name = Mid(Application.FileSearch.FoundFiles(Mappen), _
Len(Range("D1").Value) + 1, _
InStr(Application.FileSearch.FoundFiles(Mappen), _
".xls") - Len(Range("D1")) - 1) ´ neu dazu gekommendurch:
Name = Right(Application.FileSearch.FoundFiles(Mappen), _
Len(Application.FileSearch.FoundFiles(Mappen)) - Len(Range("D1").Value))
dann sollte es klappen
Gruß
Antwort 13 von Fragenkatalog
Hallo,
Danke nochmal für die ganzen Makros.
Bei mir ist das Problem, dass es nicht läuft immernoch da.
Habe das Macro auch mit F8 durchlaufen lassen und es öffnet keine Dateien, springt davor auf naechter.
kann es vielleicht daran liegen, wie ich meine Dateien in der Zeile A reinschreibe.
habe auch dafür ein Makro..
Schaut aus wie folgt und schreibt die Dateinamen so wie ich die im Explorer sehe auch in die Spalte A rein.
Sub DateiName()
Dim DatNam As String
Dim DatPfad As String
Dim zeile As Long
Sheets("Daten").Activate
DatPfad = Range("D1")
Range("A3:A65536").Clear
zeile = 3
DatNam = Dir$(DatPfad & "\*.xls")
Do While Len(DatNam) > 0
Cells(zeile, 1).Value = DatNam
zeile = zeile + 1
DatNam = Dir$()
Loop
End Sub
Danke.
Danke nochmal für die ganzen Makros.
Bei mir ist das Problem, dass es nicht läuft immernoch da.
Habe das Macro auch mit F8 durchlaufen lassen und es öffnet keine Dateien, springt davor auf naechter.
kann es vielleicht daran liegen, wie ich meine Dateien in der Zeile A reinschreibe.
habe auch dafür ein Makro..
Schaut aus wie folgt und schreibt die Dateinamen so wie ich die im Explorer sehe auch in die Spalte A rein.
Sub DateiName()
Dim DatNam As String
Dim DatPfad As String
Dim zeile As Long
Sheets("Daten").Activate
DatPfad = Range("D1")
Range("A3:A65536").Clear
zeile = 3
DatNam = Dir$(DatPfad & "\*.xls")
Do While Len(DatNam) > 0
Cells(zeile, 1).Value = DatNam
zeile = zeile + 1
DatNam = Dir$()
Loop
End Sub
Danke.
Antwort 14 von fürLau
Hallo
Kann ich hier nicht nachvollziehen, aber nimm ´mal das
On Error Resume Next
raus (remark davor schreiben) und schau was dann passiert
Gruß
Kann ich hier nicht nachvollziehen, aber nimm ´mal das
On Error Resume Next
raus (remark davor schreiben) und schau was dann passiert
Gruß
Antwort 15 von nighty
hi all
fehlervermeidung ist oftmals besser alls fehler abzufangen
sollten die fehler bekannt sein ,könnte mann den fehlercoder err in einer zelle darstellen bzw ermitteln und so in der fehlerroutine anhand einer prüfung (z.b. if err=DeinFehlerCode then) entsprechend reagieren und dann ein resume next angibt um fuer andere unbekannte fehler noch weiter reagieren zu können
gruss nighty
fehlervermeidung ist oftmals besser alls fehler abzufangen
sollten die fehler bekannt sein ,könnte mann den fehlercoder err in einer zelle darstellen bzw ermitteln und so in der fehlerroutine anhand einer prüfung (z.b. if err=DeinFehlerCode then) entsprechend reagieren und dann ein resume next angibt um fuer andere unbekannte fehler noch weiter reagieren zu können
gruss nighty
Antwort 16 von CaroS
Hi all,
zu AW12 und AW13 (läuft immer noch nicht).
Irgendwas scheint mit der Variablen Name (zuletzt:
Name = Right(Application.FileSearch.FoundFiles(Mappen), _
Len(Application.FileSearch.FoundFiles(Mappen)) - Len(Range("D1").Value)) )
nicht zu stimmen. Fragenkatalog, wenn Du sowieso schon im Debug-Modus mit F8 arbeitest, dann schalte doch mal für die Variable Name die Überwachung ein (im Code Rechtsklick auf Name -- Überwachung) und beobachte den Wert. Und für c ebenso.
(Vielleicht muss man auch noch Application.FileSearch.FoundFiles.Count und Letztezeile überprüfen, dass da wenigstens was halbwegs sinnvolles drinsteht?)
Wenn, wie angenommen, Name nicht in Ordnung ist, wird/bleibt c = .Find(Name, LookIn:=xlValues) gleich Nothing und If c Is Nothing Then GoTo naechster springt zwangsläufig zur Marke naechster:. Das scheint der Stand zu sein.
Lässt sich hier was bestätigen/wiederlegen/ausschließen?
Leider bin ich mir nicht sicher, dass ich den aktuellen Stand komplett und fehlerfrei einschließlich der gesamten Beispielsituation in eine Mappe kriege und dann wirklich am "Original" herumexperimentiere. Etwas anderes hätte aber überhaupt keinen Zweck, da würde nur noch jemand an allen anderen und dem wahren Problem vorbeireden.
Also, wenn der Fehler weiter besteht und Du Dir was davon versprichst, dann veröffentliche doch noch mal den kompletten aktuellen Stand und die wichtigsten Zusatzinformationen. Sheets("Daten"), D1 enthält den Namen des Verzeichnisses, um das es geht, A3:Axx enthält die Dateinamen in der Form Pfad_wie_in_D1\Beliebiger_Name.xls - richtig? Muss man sonst noch was wissen?
Gruß,
CaroS
zu AW12 und AW13 (läuft immer noch nicht).
Irgendwas scheint mit der Variablen Name (zuletzt:
Name = Right(Application.FileSearch.FoundFiles(Mappen), _
Len(Application.FileSearch.FoundFiles(Mappen)) - Len(Range("D1").Value)) )
nicht zu stimmen. Fragenkatalog, wenn Du sowieso schon im Debug-Modus mit F8 arbeitest, dann schalte doch mal für die Variable Name die Überwachung ein (im Code Rechtsklick auf Name -- Überwachung) und beobachte den Wert. Und für c ebenso.
(Vielleicht muss man auch noch Application.FileSearch.FoundFiles.Count und Letztezeile überprüfen, dass da wenigstens was halbwegs sinnvolles drinsteht?)
Wenn, wie angenommen, Name nicht in Ordnung ist, wird/bleibt c = .Find(Name, LookIn:=xlValues) gleich Nothing und If c Is Nothing Then GoTo naechster springt zwangsläufig zur Marke naechster:. Das scheint der Stand zu sein.
Lässt sich hier was bestätigen/wiederlegen/ausschließen?
Leider bin ich mir nicht sicher, dass ich den aktuellen Stand komplett und fehlerfrei einschließlich der gesamten Beispielsituation in eine Mappe kriege und dann wirklich am "Original" herumexperimentiere. Etwas anderes hätte aber überhaupt keinen Zweck, da würde nur noch jemand an allen anderen und dem wahren Problem vorbeireden.
Also, wenn der Fehler weiter besteht und Du Dir was davon versprichst, dann veröffentliche doch noch mal den kompletten aktuellen Stand und die wichtigsten Zusatzinformationen. Sheets("Daten"), D1 enthält den Namen des Verzeichnisses, um das es geht, A3:Axx enthält die Dateinamen in der Form Pfad_wie_in_D1\Beliebiger_Name.xls - richtig? Muss man sonst noch was wissen?
Gruß,
CaroS
Antwort 17 von Fragenkatalog
Hallo an alle,
erstmal freut es mich sehr dass es so viele gibt, die sich hier für das Problem interessieren und auch mitwirken um es zu lösen.
doch ich denke ich habe den Fehler gefunden.
Der Fehler besteht, nur darin dass ich in meinem Pfad also Zelle D1 folgendes reinschreibe.
C:\ordner1\ordner2\unterordner.
anscheinend muss ich damit das Makro läuft ein weiteres "\" hinter den Pfad eintippen. Sonst findet das Makro die Dateien nicht.
Kleines Zeichen großer Fehler. kamm man eigentlich das nicht im Makro umschreiben, damit es auch reicht wenn ich den Pfad aus dem Explorer rauskopiere.
Also ohen "\" am ende?
Danke hier noch einmal des Programm.
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´geändert
Dim c As Range ´neu dazu gekommen
Dim Name As String ´neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("A65535").End(xlUp).Row ´neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´neu dazu gekommen
Name = Right(Application.FileSearch.FoundFiles(Mappen), _
Len(Application.FileSearch.FoundFiles(Mappen)) - Len(Range("D1").Value))
Set c = .Find(Name, LookIn:=xlValues) ´neu dazu gekommen
End With ´neu dazu gekommen
If c Is Nothing Then GoTo naechster ´neu dazu gekommen und geändert
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
Danke
erstmal freut es mich sehr dass es so viele gibt, die sich hier für das Problem interessieren und auch mitwirken um es zu lösen.
doch ich denke ich habe den Fehler gefunden.
Der Fehler besteht, nur darin dass ich in meinem Pfad also Zelle D1 folgendes reinschreibe.
C:\ordner1\ordner2\unterordner.
anscheinend muss ich damit das Makro läuft ein weiteres "\" hinter den Pfad eintippen. Sonst findet das Makro die Dateien nicht.
Kleines Zeichen großer Fehler. kamm man eigentlich das nicht im Makro umschreiben, damit es auch reicht wenn ich den Pfad aus dem Explorer rauskopiere.
Also ohen "\" am ende?
Danke hier noch einmal des Programm.
Option Explicit
Sub Zusammenfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Long ´geändert
Dim c As Range ´neu dazu gekommen
Dim Name As String ´neu dazu gekommen
On Error Resume Next
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Sheets("Daten").Select
With Application.FileSearch
.NewSearch
.LookIn = Range("D1")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Letztezeile = Range("A65535").End(xlUp).Row ´neu dazu gekommen
For Mappen = 1 To .FoundFiles.Count
With Range("A3:A" & CStr(Letztezeile)) ´neu dazu gekommen
Name = Right(Application.FileSearch.FoundFiles(Mappen), _
Len(Application.FileSearch.FoundFiles(Mappen)) - Len(Range("D1").Value))
Set c = .Find(Name, LookIn:=xlValues) ´neu dazu gekommen
End With ´neu dazu gekommen
If c Is Nothing Then GoTo naechster ´neu dazu gekommen und geändert
Workbooks.Open Filename:=.FoundFiles(Mappen)
Application.Calculate
Danke
Antwort 18 von CaroS
Hi,
Du müsstest etwa in der Mitte .LookIn = Range("D1") durch
.LookIn = Range("D1") & "\" ersetzen, d. h. & "\" hinten dranhängen. Und testen, ob´s funktioniert. Notfalls auch mit F8 und Überwachung der Variablen.
Gruß,
CaroS
Du müsstest etwa in der Mitte .LookIn = Range("D1") durch
.LookIn = Range("D1") & "\" ersetzen, d. h. & "\" hinten dranhängen. Und testen, ob´s funktioniert. Notfalls auch mit F8 und Überwachung der Variablen.
Gruß,
CaroS