Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datenimport bei "Fehler"

Forumthread: Datenimport bei "Fehler"

Datenimport bei "Fehler"
25.06.2020 13:52:48
Fred

Hallo Excel,- VBA Experten,
ich habe vor längerer Zeit bei der Recherche hier auf "Herbers Excel/VBA-Server" ein Makro entdeckt, welches mir
aus gleichen Ordner die .xlsm Dateien öffnet
die Daten ab Zeile 3 aus Tabellenblatt "ArchivExport" in meine ausgehende Mappe / "Tabelle1" kopiert.
_________________
Das funktioniert blendend bis zu dem Moment, dass wenn die xlsm nicht das Blatt "ArchivExport" hat,
Laufzeitfehler 9
"Index außerhalb des gültigen Bereichs"
erscheint.
Gelb unterlegt:
Set wksQuelle = wkbQuelle.Worksheets("ArchivExport")
__________________
Meine Frage;
Könnte ein Experte mir das Makro dahin verändern, so dass (wenn dieser "Fehler" auftaucht) die entsprechende xlsm geschlossen wird und das Makro weiter arbeitet ( weitere xlsm sucht, öffnet, Daten aus "ArchivExport" importiert)?
Das Makro
Sub Zusammenfuegen()
Dim strDateiname As String
Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsm")
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
Set wksQuelle = wkbQuelle.Worksheets("ArchivExport")
loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With wksQuelle
loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
End With
wkbQuelle.Close True
End If
strDateiname = Dir
Loop
Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Application.ScreenUpdating = True
End Sub
Mit freundlichen Gruß
Fred
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Datenimport bei "Fehler"/ Nachtrag
25.06.2020 14:00:28
Fred
... Nachtrag;
es wäre auch schon sehr hilfreich, wenn man nur "einbauen" könnte, welche Dateien im Ordner nicht berücksichtigt werden sollen,- wären 3-4
Fred
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 14:07:50
Werner
Hallo,
teste mal:
Sub Zusammenfuegen()
Dim strDateiname As String
Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Dim i As Long
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsm")
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
With wkbQuelle
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "ArchivExport" Then
Exit For
Set wksQuelle = .Worksheets("ArchivExport")
loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With wksQuelle
loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
End With
.Close True
Else
.Close False
End If
Next i
End With
End If
strDateiname = Dir
Loop
Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 14:50:10
Fred
Hallo Werner,
klappt leider nicht.
Bei Ausführung kommt Meldung (Wenn eine xlsm nicht Blatt "ArchivExport" aufweist):
Laufzeitfehler -2147221080 (800401a8)
Automatisierungsfehler
will ich dann zum Debugger
Warnmeldung
Nicht genügend Speicher
Die Meldung "nicht genügend Speicher tritt allerdings nur beim erstenmal auf,- will ich das Makro ein zweites mal starten, "nur"
Laufzeitfehler -2147221080 (800401a8)
Automatisierungsfehler
Gruss
Fred
Anzeige
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 16:06:26
Alex
Hm, probier mal das 'Exit For' hinter das '.Close True' zu verschieben:
               If .Worksheets(i).Name = "ArchivExport" Then
Set wksQuelle = .Worksheets("ArchivExport")
loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With wksQuelle
loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
End With
.Close True
Exit For
Else

Anzeige
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 16:43:57
Fred
Hallo Alex,
die Fehlermeldung bleibt die gleiche :-(
Gruss
Fred
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 16:59:05
peterk
Hallo
Ihr macht ja das Workbook zu und wollt dann weiter sheets abfragen

Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
With wkbQuelle
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "ArchivExport" Then
Else
.Close False  ' 

Sollte wohl eher so aussehen:

Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
With wkbQuelle
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "ArchivExport" Then
Set wksQuelle = .Worksheets("ArchivExport")
loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With wksQuelle
loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
End With
End If
Next i
.Close True
End With
End If
strDateiname = Dir
Loop

Anzeige
AW: Datenimport bei "Fehler"/ Nachtrag
25.06.2020 19:14:08
Fred
jo, peterK,
ist wie nach 22:00h bei Karstadt einkaufen zu wollen.
Vielen Dank für deine Aufmerksamkeit und die Lösung!
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige