MadmonkeyM

HAllo zusammen, ich habe hier ein kleines Problem mit meinem Code. Der Code soll alle Excel dateien in diesem Ordner durchsuchen und aus dem ersten Tabellenblatt die Informationen von Zeile 2 bis 40 kopieren und in eine neue Liste einfügen. So nun kopiert mir der Code alles und fügt es auch ein aber nur als Formel mit Verlinkung auf die Orginal Datei. Wie könnte man den Code umschreiben damit ich in der Übersicht nur einen Text in jeder Zelle habe ohne die Formel auf die Orgninal datei. Sub uebersicht() Dim datei As String, pfad As String, Zzeile As Long, i%, suche, AZelle As Range Dim quelle As Object pfad = "\\Server\Testordner\" datei = Dir(pfad & "*.xls") Application.ScreenUpdating = False Zzeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 Do While Not datei = "" Set quelle = Workbooks.Open(pfad & datei) For i = 2 To 40 suche = quelle.Sheets(1).Cells(i, 1).Value With ThisWorkbook.Sheets(1).Columns(1) Set AZelle = .Find(suche, LookAt:=xlWhole, LookIn:=xlValues) If AZelle Is Nothing Then quelle.Sheets(1).Rows(i).Copy Destination:=.Cells(Zzeile, 1) Zzeile = Zzeile + 1 End If End With Next i quelle.Close datei = Dir DoEvents Loop Application.ScreenUpdating = True Danke Euch schon einmal

So hab jetzt selber eine Lösung gefunden. Der Code hier funktioniert: Sub uebersicht() Dim datei As String, pfad As String, Zzeile As Long, i%, suche, AZelle As Range Dim quelle As Object pfad = "\\Medico1\Serverdaten\Rechnungen 2010\01 Januar 0040-\" datei = Dir(pfad & "*.xls") Application.ScreenUpdating = False Zzeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 Do While Not datei = "" Set quelle = Workbooks.Open(pfad & datei) For i = 2 To 40 suche = quelle.Sheets(1).Cells(i, 1).Value With ThisWorkbook.Sheets(1).Columns(1) Set AZelle = .Find(suche, LookAt:=xlWhole, LookIn:=xlValues) If AZelle Is Nothing Then quelle.Sheets(1).Rows(i).Copy Destination:=.Cells(Zzeile, 1) Zzeile = Zzeile + 1 End If End With Next i quelle.Close datei = Dir DoEvents Loop Application.ScreenUpdating = True End Sub Und wenn man mehrere Ordner durchsuchen möchte dann muss man einfach nur nochmal einen teil des Codes anhängen. pfad = "\\Medico1\Serverdaten\Rechnungen 2010\Rechnungsblöcke\" datei = Dir(pfad & "*.xls") Application.ScreenUpdating = False Zzeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 Do While Not datei = "" Set quelle = Workbooks.Open(pfad & datei) For i = 2 To 40 suche = quelle.Sheets(1).Cells(i, 1).Value With ThisWorkbook.Sheets(1).Columns(1) Set AZelle = .Find(suche, LookAt:=xlWhole, LookIn:=xlValues) If AZelle Is Nothing Then quelle.Sheets(1).Rows(i).Copy Destination:=.Cells(Zzeile, 1) Zzeile = Zzeile + 1 End If End With Next i quelle.Close datei = Dir DoEvents Loop Application.ScreenUpdating = True ISt vielleicht nicht umbedingt die schönste Lösung aber sie funktioniert zumindest. Dank an alle die versucht haben mir zu helfen

So nachmal eine Ergänzung mit folgendem Pfad funktioniert es, aber leider nur wenn der Ordner bei mir aufm Desktopm liegt. pfad = Environ("HOMEPATH") & "\Desktop\Test\" hier sind die Dateien in einem Ordner und liegen im Ordner Test aufm Desktop So nun habe ich die Rechnungen aber auf Server liegen das müsste dann doch so aussehen : pfad = Environ("HOMEPATH") & "\\Serverdaten\Rechnungen 2010\ 01 Januar\" Das funktioniert schon mal nicht und außerdem hätte ich ja dann nur den Januar geöffnet und müsste den rest auch nochmal öffnen. Was gibt es hier für eine Möglichkeit ? Ich hänge nur noch an dem Pfad der Rest funktioniert

Hoppala da war ich oben wohl etwas abwesend so sollte es eigentlich aussehen:D In erster Linie hab ich erst mal n Problem den Pfad auf den Server zu legen ... Und dann ist da immer noch das Problem das Excel mit nicht die Ordner durchschaut und die Excel Dateien durchsucht, kopiert und einfügt. HAtte gedacht das der Pfad wie folgt ausschauen muss \\Serverdaten\Rechnungen 2010\ die Ordner heißen dann wie folgt 01 Januar 2010 02 Febraur 2010 etc es wurde bei meinem Pfad den ich angewendet hatte nicht ausgeführt oder ich habe den Fehler "Ungültige ... " weiß die genaue Benennung nicht mehr.

In erster Linie hab ich erst mal n Problem den Pfad auf den Server zu legen ... Und dann ist da immer noch das Problem das Excel mit nicht die Ordner durchschaut und die Excel Dateien durchsucht, kopiert und einfügt. HAtte gedacht das der Pfad wie folgt ausschauen muss //Serverdaten/Rechnungen 2010/ die Ordner heißen dann wie folgt 01 Januar 2010 02 Febraur 2010 etc es wurde bei meinem Pfad den ich angewendet hatte nicht ausgeführt oder ich habe den Fehler "Ungültige ... " weiß die genaue Benennung nicht mehr.

Es geht nicht darum das ihr meine Verzeichnisstruktur kennen sollt sondern mir z.B. erklärt wie man auf einen Server bzw. einen Ordner von einem Server verweist. Dann weiß ich nicht ob das was ich bisher geschrieben habe überhaupt für sowas geeignet ist, geschweige denn ob es richtig ist. Ich hatte gehofft das es evtl Ergänzungen gibt. Vielen Dank all denen die mir zu helfen versuchen

Hi also das folgende hatte ich mal aufm Desktop laufen da hat es auch funktioniert aber ich bekomm das jetzt mit der neuen Ordnerstruktur nicht mehr hin... Bitte nicht lachen ich hab echt null ahnung und hab mir das ganze erst mal irgendwie zusammengebaut Sub uebersicht() Dim datei As String, pfad As String, Zzeile As Long, i%, suche, AZelle As Range Dim quelle As Object pfad = Environ("HOMEPATH") & "Pfad" ' Serverpfad funktioniert nicht datei = Dir(pfad & "*.xls") Application.ScreenUpdating = False Zzeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 Do While Not datei = "" Set quelle = Workbooks.Open(pfad & datei) For i = 2 To 40 suche = quelle.Sheets(1).Cells(i, 1).Value With ThisWorkbook.Sheets(1).Columns(1) Set AZelle = .Find(suche, LookAt:=xlWhole, LookIn:=xlValues) If AZelle Is Nothing Then quelle.Sheets(1).Rows(i).Copy Destination:=.Cells(Zzeile, 1) Zzeile = Zzeile + 1 End If End With Next i quelle.Close datei = Dir DoEvents Loop Application.ScreenUpdating = True End Sub Danke erst mal <edit> Bitte Code-Tags verwenden, dann bleibt auch die Formatierung erhalten </edit>

Hallo, erst mal danke für Eure Antworten. Könnt Ihr mir vielleicht einen Mustercode zukommen lassen ? Danke

Hallo zusammen, ich bin ein absoluter Neuling im bezug auf VBA und Excel. Ich hab für unsere Firma ein kleines "Rechnungsprogramm in VBA geschrieben was soweit auch ganz gut läuft. Leider hab ich erst zu spät gemerkt das das ganze Thema eher ein Fall für Access wäre. Naja zu spät. Nun stehe ich vor einem scheinbar unlösbaren Problem. Wir haben auf unserem Server einen Ordner angelegt in dem für jeden Monat ein Ordner ist. In diesen Ordner sind dann widerrum je nach Monat zwischen 20 und 30 Excel Dateien wo unsere Rechnungen gespeichert werden. Der Aufbau dieser Excel Dateien ist wie folgt. 1. Tabellenblatt ist eine Übersicht (TAbellenblattname "Übersicht") der geschriebenen Rechnungen aus diesem Monat, erste Zeile sind die Überschriften und dann von Zeile 2-40 die Daten der Rechnungen. Genutz werden hier die Spalten A-J. Diese Liste sieht in jeder Excel Datei gleich aus ! NAch diesem Tabellenblatt folgen die die REchnungsblätter. In Summe in jeder Datei 39 Rechnungen. Die Ordner in denen diese Dateien liegen sind alle gleich aufgebaut und heißen 01 Januar xxx-xxx, 02 Februar xxx-xxx wobei das xxx jeweils für die verwendeten Rechnungsnummer in diesem Monat steht. Nun aber zu eigentlichen Problem: Ich würde gerne eine Masterliste aus allen Rechnungen erstellen die auch immer wieder automatisch aktualisiert wird. D.h. eine Zusammenfassung aller Rechnungsübersichten der einzelnen Exceldateien. ISt sowas überhaupt möglich ? Wenn ja wie muss ich vorgehen ich kenn mich echt fast ned aus. Tut mir leid das ich euch so nen Text gepresst habe ich habe nur versucht alles so gut wie möglich zu beschreiben. Vielen Dank schon einmal für eure Hilfe