Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
632to636
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
632to636
632to636
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datein automatisch öffnen

Datein automatisch öffnen
06.07.2005 15:56:42
Betro
Hallo Zusammen,
ich habe ca. 500-Excel Datein die mit A beginen (z.Bsp: A080, A081...A510). Ich will jetz den Inhalt der Einzelnen Datein entnehmen und in eine Datenbank eintragen. Gibt eine Möglichkeit mit eine While-Schleife die einzelnen Datein zu öffnen, den Inhalt zu kopieren und dann wiered zu schliesen. Alle Datein haben den gleichen Muster.
Bis jetzt habe ich diesen Program entwikelt, aber der Zeigt mir einen Fehler in der Zeile: ".Range("B12").Copy Db.Range("A1").End(xlDown).Offset(0, 2)". Kann mir jemand weiter helfen?

Sub save()
Const verz = "C:\Reparaturannahme2\Reperatur"
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
End With
For y = 1 To Application.FileSearch.FoundFiles.Count
Set quelle = Workbooks.Open(Application.FileSearch.FoundFiles(y))
Workbooks.Open "X:\Reparaturannahme2\Reperatur\Data.xls"
Workbooks("Data.xls").Sheets("Tabelle1").Select
Range("Zahl").Select
Range("Zahl").Value = Range("Zahl").Value + 1
Selection.Copy
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
Set Db = Workbooks("Data.xls").Sheets("Tabelle1")
With quelle
If Range("A2") <> "" Then
'.Range("G12").Copy Db.Range("A1").End(xlDown).Offset(0, 1)
.Range("B12").Copy Db.Range("A1").End(xlDown).Offset(0, 2)
.Range("B13").Copy Db.Range("A1").End(xlDown).Offset(0, 3)
.Range("E14").Copy Db.Range("A1").End(xlDown).Offset(0, 4)
.Range("E13").Copy Db.Range("A1").End(xlDown).Offset(0, 5)
.Range("B3").Copy Db.Range("A1").End(xlDown).Offset(0, 6)
.Range("B7").Copy Db.Range("A1").End(xlDown).Offset(0, 8)
.Range("B4").Copy Db.Range("A1").End(xlDown).Offset(0, 9)
.Range("B5").Copy Db.Range("A1").End(xlDown).Offset(0, 10)
.Range("B6").Copy Db.Range("A1").End(xlDown).Offset(0, 11)
.Range("B8").Copy Db.Range("A1").End(xlDown).Offset(0, 12)
.Range("B9").Copy Db.Range("A1").End(xlDown).Offset(0, 13)
.Range("B14").Copy Db.Range("A1").End(xlDown).Offset(0, 14)
.Range("E12").Copy Db.Range("A1").End(xlDown).Offset(0, 15)
Else
'.Range("G12").Copy Db.Range("B2")
.Range("B12").Copy Db.Range("C2")
.Range("B13").Copy Db.Range("D2")
.Range("E14").Copy Db.Range("E2")
.Range("E13").Copy Db.Range("F2")
.Range("B3").Copy Db.Range("G2")
.Range("B7").Copy Db.Range("I2")
.Range("B4").Copy Db.Range("J2")
.Range("B5").Copy Db.Range("K2")
.Range("B6").Copy Db.Range("L2")
.Range("B8").Copy Db.Range("M2")
.Range("B9").Copy Db.Range("N2")
.Range("B14").Copy Db.Range("O2")
.Range("E12").Copy Db.Range("P2")
End If
End With
Workbooks("Data.xls").Sheets("Formulare").Select
Workbooks("Data.xls").save
Application.CutCopyMode = False
quelle.Saved = False
quelle.Close
Next y
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datein automatisch öffnen
08.07.2005 15:03:10
Marc
Hallo Betro,
du hattest diesen Beitrag bereits schon mal gestellt, aber egal.
Du hattest lediglich den TeilCode an die falsche Stelle eingefügt.
Bei dir soll erst Data.xls geöffnet werden, dann etwas kopiert werden und dann soll
erst die anderen Dateien geöffnet werden und die Daten daraus kopiert werden.
Probier mal diesen Code jetzt aus...
Gruß Marc

Sub save()
Workbooks("A2.xls").Sheets("Aufträge").Select
Range("Zahl").Select
Range("Zahl").Value = Range("Zahl").Value + 1
Selection.Copy
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
strSuchtext = Range("I1").Value
'_____________________________________________________________________________________________________
'Hier ist deine OpenFunktion wo du die Dateien mit A...xls öffnen willst
'Workbooks.Open "X:\Reparaturannahme2\A080.xls"
'_____________________________________________________________________________________________________
'statt deine OpenFunktion kommt die automatische OpenFunktion
Const verz = "X:\Reparaturannahme2"
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = True
.Filename = "A*.xls"
.Execute
End With
For y = 1 To Application.FileSearch.FoundFiles.Count
Set quelle = Workbooks.Open(Application.FileSearch.FoundFiles(y))
'_____________________________________________________________________________________________________
Set Db = Workbooks("A2.xls").Sheets("Aufträge")
With Workbooks(quelle)
If Range("A2") <> "" Then
'.Range("G12").Copy Db.Range("A1").End(xlDown).Offset(0, 0)
.Range("B12").Copy Db.Range("A1").End(xlDown).Offset(0, 2)
.Range("B13").Copy Db.Range("A1").End(xlDown).Offset(0, 3)
.Range("E14").Copy Db.Range("A1").End(xlDown).Offset(0, 4)
.Range("E13").Copy Db.Range("A1").End(xlDown).Offset(0, 5)
.Range("B3").Copy Db.Range("A1").End(xlDown).Offset(0, 6)
.Range("B7").Copy Db.Range("A1").End(xlDown).Offset(0, 8)
.Range("B4").Copy Db.Range("A1").End(xlDown).Offset(0, 9)
.Range("B5").Copy Db.Range("A1").End(xlDown).Offset(0, 10)
.Range("B6").Copy Db.Range("A1").End(xlDown).Offset(0, 11)
.Range("B8").Copy Db.Range("A1").End(xlDown).Offset(0, 12)
.Range("B9").Copy Db.Range("A1").End(xlDown).Offset(0, 13)
.Range("B14").Copy Db.Range("A1").End(xlDown).Offset(0, 14)
.Range("E12").Copy Db.Range("A1").End(xlDown).Offset(0, 15)
Else
'.Range("G12").Copy Db.Range("A2")
.Range("B12").Copy Db.Range("C2")
.Range("B13").Copy Db.Range("D2")
.Range("E14").Copy Db.Range("E2")
.Range("E13").Copy Db.Range("F2")
.Range("B3").Copy Db.Range("G2")
.Range("B7").Copy Db.Range("I2")
.Range("B4").Copy Db.Range("J2")
.Range("B5").Copy Db.Range("K2")
.Range("B6").Copy Db.Range("L2")
.Range("B8").Copy Db.Range("M2")
.Range("B9").Copy Db.Range("N2")
.Range("B14").Copy Db.Range("O2")
.Range("E12").Copy Db.Range("P2")
End If
End With
Workbooks("A2.xls").Sheets("Formulare").Select
Workbooks("A2.xls").save
'___________________________________________________________________________________________
Application.CutCopyMode = False
quelle.Saved = False
quelle.Close
Next y
'___________________________________________________________________________________________
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige