Dateien auslesen
23.10.2019 10:58:41
Jonas
habe mir ein VBA geschrieben das mir files in einem ordner findet und die dateinamen ausliest.
Nun hab ich weiter in VBA geschrieben, dass er alle diese files durchgehen soll und mir jede Zeile in der "e1_100" steht kopieren soll. Diese Zeilen werden dann in der Ausgabe einfach untereinander eingefügt.
Leider funktioniert das ganze noch nicht, ich glaube ich hab ein Range-problem. Meine Urpsrungsfiles haben 5 spalten, A-E.
Die neue grosse Excel hat ebenfalls 5 spalten zum einfügen von A-E.
Kann mir einer helfen was ich falsch mache? mit dem Code hier kopiert er mir immer nur die erste Zeile jedes files.. das heisst er scannt gar nicht nach e1_100.
Sub Import_Function()
Dim Input_WS As Workbook
Dim Output_WS As Workbook
Dim Location As String
Dim i As Long
'Workbook vorbereiten
Set Output_WS = ActiveWorkbook
ActiveSheet.Range("A2:E999999").Clear
'Input-Workbook kommt über Schleifen
For i = 2 To InputBox("Wieviele Input-Blätter gibt es?") + 1
Output_WS.Sheets(1).Activate
Location = Cells(i, "H").Value
Workbooks.Open Filename:=Location
Set Input_WS = ActiveWorkbook
'Datenimport Teil 1: Range auslesen
If i = 2 Then
Zielzeile = 2
Else:
Zielzeile = Output_WS.Sheets(1).Range("A1").End(xlDown).Row + 1
End If
'Filter einstellen
Input_WS.Sheets(1).Range("A1:E" & Input_WS.Sheets(1).Range("A1").End(xlDown).Row). _
AutoFilter
Input_WS.Sheets(1).Range("A1:E" & Input_WS.Sheets(1).Range("A1").End(xlDown).Row). _
AutoFilter Field:=2, Criteria1:="e1_100"
'Zeilen mit Werten berechnen
If Input_WS.Sheets(1).Range("A2").End(xlDown).Row > 9999 Then
Endzeile = 2
Else:
Endzeile = Input_WS.Sheets(1).Range("E2").End(xlDown).Row
End If
'Zellen kopieren
Input_WS.Sheets(1).Range("A2:E" & Endzeile).Copy
Output_WS.Sheets(1).Cells(Zielzeile, 1).PasteSpecial xlPasteValues
Application.DisplayAlerts = False
Input_WS.Close
Set Input_WS = Nothing
Next i
Application.DisplayAlerts = True
End Sub
Sub DateinamenAuflisten()
Dim Dateiname As String
Dim i As Long
Dateiname = Dir$(ActiveSheet.Range("K2").Value) 'Hier Verzeichnis und Datei angeben
Do While Dateiname ""
Range("G2").Activate
ActiveCell.Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
End Sub
Danke euch!!!