Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA Zellen suchen und kopieren
#1
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!!!
Antwortento top
#2
Für alle zur Info:
http://www.office-loesung.de/p/viewtopic.php?f=166&t=820944
Antwortento top
#3
Hallöchen,

gehe das Kopiermakro mal mit F8 schrittweise durch und schaue insbesondere, was beim Filtern passiert...
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste