Hallo Zusammen,
ich habe folgendes Problem und leider wenig Ahnung von VBA.
Ich habe mehrere Dateien in einem Ordner, aus welchen ich bestimmte Zellen auslesen muss.
Bis dato hat das ein Kollege bei uns gemacht, welcher aber leider nicht mehr bei uns ist.
In der Vergangenheit hatte die auszulesende Datei nur ein Tabellenblatt. Heute kann sie auch ein zweites enthalten, welches dann ausgelesen werden muss und die Zellen in der "Zusammenfassungsdatei" in einen separaten Reiter kopiert werden mussen.
Die Daten sollten einfach untereinander geschrieben werden.
Hier das Makro was ich übernommen habe, ohne die Funktion ein mögliches zweites Tabellenblatt in der Quelldatei auszulesen:
Sub Auslesen()
Dim cDir As String
Dim sPath As String
Dim Count As Integer
Dim Filecount As Integer
Dim quelldatei As Workbook
Dim Zieldatei As Workbook
sPath = Range("B7").Text
cDir = Dir(sPath & "*.xlsx")
Count = 2
Filecount = 0
Do While cDir <> ""
Set quelldatei = Workbooks.Open(sPath & cDir)
Filecount = Filecount + 1
With quelldatei.Sheets(1)
For i = 10 To 95
If quelldatei.Sheets(1).Cells(i, 14) = "" Then
Else
Tabelle1.Cells(Count, 1) = quelldatei.Sheets(1).Cells(4, 4)
Tabelle1.Cells(Count, 2) = quelldatei.Sheets(1).Cells(7, 4)
Tabelle1.Cells(Count, 3) = quelldatei.Sheets(1).Cells(i, 3)
Tabelle1.Cells(Count, 4) = quelldatei.Sheets(1).Cells(i, 4)
Tabelle1.Cells(Count, 5) = quelldatei.Sheets(1).Cells(i, 5)
Tabelle1.Cells(Count, 6) = quelldatei.Sheets(1).Cells(i, 6)
Tabelle1.Cells(Count, 7) = quelldatei.Sheets(1).Cells(i, 14)
Count = Count + 1
End If
Next i
End With
ActiveWorkbook.Close False
'nächste Datei lesen
cDir = Dir
Loop
MsgBox (Filecount & " wurden eingelesen")
End Sub
Ich hoffe ihr könnt mir helfen, mein Chef sitzt mir im Nacken! :)
Vielen Dank im Voraus!
Gruß, David