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