Clever-Excel-Forum

Hi Leute,

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.

Code:
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

Code:
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!!!

Für alle zur Info:
http://www.office-loesung.de/p/viewtopic.php?f=166&t=820944

Hallöchen,

gehe das Kopiermakro mal mit F8 schrittweise durch und schaue insbesondere, was beim Filtern passiert...

joko

Lutz Fricke

schauan