Hallo,

geht grundsätzlich mit einem Makkro.

Auch ich habe hier schon mal eine Lösung dazu eingestellt, finde diese aber im Moment nicht.

Gruß

Helmut

Hallo Player1987,

nachfolgendes Makro sollte das in etwa machen, was Du Dir vorgestellt hast.

Kopiere das Makro in ein StandardModul und starte das Makro "Auswertung_start" z.B. über eine Befehlsschaltfläche

[b]Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer
Dim Summe_B2 As Variant

Const Pfad = "C:\Beispielmappen\"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B6")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("Typ1").Cells(ThisWorkbook.Sheets("Typ1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("C11:D16").Copy
ThisWorkbook.Sheets("Typ2").Cells(ThisWorkbook.Sheets("Typ2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("C12:D17").Copy
ThisWorkbook.Sheets("Typ3").Cells(ThisWorkbook.Sheets("Typ3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("C13:D18").Copy
ThisWorkbook.Sheets("Typ4").Cells(ThisWorkbook.Sheets("Typ4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("C14:D19").Copy
ThisWorkbook.Sheets("Typ5").Cells(ThisWorkbook.Sheets("Typ5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub
[/b]

Mit dem Makro werden alle Dateien in einem Verzeichnis und deren Unterverzeichnissen geöffnet, der Wert aus Zelle B6 ausgelesen und die Daten entsprechend der Vorgabe in der Case-Anweisung kopiert und eingefügt.

Du musst die Bereich, die kopiert werden sollen im Makro noch anpassen. Außerdem musst Du bei der Angabe

[b]Const Pfad = "C:\Beispielmappen\"[/b]

den Pfad, in dem sich die Dateien befinden angeben.

Ich hoffe, Du kommst klar.
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Also habe gerade noch etwas festgestellt das ich vergessen habe.
In den einzelnen Dateien heisen die Tabellenblätter nicht Tabelle1 sondern immer wie die Detei selber. Also wenn die Datei aaaa.XLS heist dann heist das tabellenblatt aaaa.

Könntest du deinen Code so schreiben, dass du mir alles schräg schreibst was ich ändern muss, denn irgendwie klappt das noch nicht so ganz.

Hallo Player1987,

alles was unterstrichen ist, muss unter Umständen angepasst werden.

[b]Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer

Const Pfad = "[u]C:\Beispielmappen\[/u]"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B6")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("[u]C10:D15[/u]").Copy
ThisWorkbook.Sheets("Typ1").Cells(ThisWorkbook.Sheets("Typ1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("[u]C11:D16[/u]").Copy
ThisWorkbook.Sheets("Typ2").Cells(ThisWorkbook.Sheets("Typ2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("[u]C12:D17[/u]").Copy
ThisWorkbook.Sheets("Typ3").Cells(ThisWorkbook.Sheets("Typ3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("[u]C13:D18[/u]").Copy
ThisWorkbook.Sheets("Typ4").Cells(ThisWorkbook.Sheets("Typ4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("[u]C14:D19[/u]").Copy
ThisWorkbook.Sheets("Typ5").Cells(ThisWorkbook.Sheets("Typ5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub
[/b]

Bezüglich des Blattnamens in den Dateien, die ausgelesen werden sollen. Ist dort immer nur ein Tabellenblatt enthalten oder mehrere?

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

es ist immer nur ein tabellenblatt enthalten

Hallo Player1987,

dann ist der Name des Tabellenblattes egal, da das Makro sich immer am 1. Tabellenblatt orientiert und dort die Werte ausließt und kopiert.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Ich bekomme jetzt immer den Fehler 91
und diese Zeile ist gelb hinterlegt

For Each Dateityp In Dateien.Files

oh nein der fehler war weil es zwei makros gab. wenn ich das untere mit dem auswertung_start nehme, dann kommt kein fehler, aber er kopiert auch nichts

Hallo Player1987,

stimmt der Pfad, den Du angegeben hast?


MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

ja der pfad stimmt, er macht auch irgendwas, aber er schreibt mir nix hin.

noch was anderes. werden die xls. dateien alle auf einmal geändert oder werden die wenn die werte kopiert wurden wieder geschlossen. mir wäre zweiteres lieber.

Hallo Player1987,

die Dateien werden nacheinander geöffnet, der Wert aus Zelle B6 wird ausgelesen und es werden die Daten aus Spalte C und D in die Datei, aus das Makro aufgerufen wurde, in das Tabellenblatt, dessen Nummer in der auszulesenden Datei in Zelle B6 steht hineinkopiert. Danach wird die Datei wieder geschlossen.

Du kannst Dir das alles auch im VBA-Editor ansehen. Wenn Du den geöffnet hast, positioniere den Cursor irgendwo im Makro "Auswertung_start" und betätige danach für jeden Schritt die Taste F8.

Warum bei Dir nicht kopiert wird, kann ich Dir im Moment auch nicht sagen, da ich Deine Daten nicht hier vor mir habe. Besteht die Möglichkeit mir Deine Masterdatei und ein paar von den Dateien, die ausgelesen werden sollen, mal per Mail zu schicken. Dann kann ich schauen wo es klemmt. Die Mail findest Du überall auf meiner HP . Binde in der Betreffzeile irgendwie das Wort "Supportnet" und den Namen (Nickname), unter dem Du hier gepostet hast mit ein, da ich alle Mails deren Absender ich nicht kenne, ungelesen lösche.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

also ich erkläre es nochmal ganz kurz wenn in B6 der wert 3 steht, dann muss es in das tabellenblatt typ3 der data.xls kopiert werden.
wenn in B6 der Wert 4 steht, dann muss er in das Tabellenblatt Typ4 kopiert werden und halt mit den anderen entsprechend.

Aber danke schonmal so weit hat mir noch keiner geholfen

alles klar die mail geht in 5-10 minuten an dich raus.
gruss und dnake

Hallo Player1987,

das wird in dem Makro bereits realisiert, was Du schreibst. Das sind die Case-Anweisungen 1 bis 5. Wenn Du schaust, steht z.B. nach der Anweisung "Case1"

[b]ThisWorkbook.Sheets("[u]Typ1[/u]").Cells(ThisWorkbook.Sheets("[u]Typ1[/u]").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial[/b]

(achte auf das Unterstrichene) in der Zeile, dass die Daten in die Deine Datei in Blatt "Typ1" kopiert werden soll.

Wie bereits erwähnt, benötigt man nun sicherlich zur Findung des Problems Deine Daten.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

mail ist raus

mit folghendem betreff:

Supportnet Player1987

Gruss

Hallo Player1987,

Du hattest zum Einen einen Backslash im Pfad vergessen und Du hast anstelle von B6 in der Zeile

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B15")

wie Du siehst B15 eingetragen. Daher konnte das nicht funktionieren. NAchfolgend das geänderte Makro, wie es bei mir funktioniert hat. Die fehlerhaften Stellen habe ich mal unterstrichen.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche

[b]Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer

Const Pfad = "l:\testkalib[u]\[/u]"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("[u]B6[/u]")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("C11:D16").Copy
ThisWorkbook.Sheets("1").Cells(ThisWorkbook.Sheets("1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("2").Cells(ThisWorkbook.Sheets("2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("3").Cells(ThisWorkbook.Sheets("3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("4").Cells(ThisWorkbook.Sheets("4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("5").Cells(ThisWorkbook.Sheets("5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 6
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("6").Cells(ThisWorkbook.Sheets("6").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 7
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("7").Cells(ThisWorkbook.Sheets("7").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
Workbooks(Dateityp.Name).Close
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub
[/b]

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Oh mein Gott.
Du hast es geschafft.
Unglaublich dieser kleine Schrägstrich war das Problem.
Das mit dem B15 war nur ein Test ob es mit einer anderen Zelle klappt.


Also DANKE DANKE DANKE

Hallo Player1987,

gern geschehn. Danke auch für die Rückmeldung.

MfG,
Oliver
^{Jeder macht was er will, keiner macht was er soll, aber alle machen mit.}

Hi,
ich habe nochmals ein Problem.
Und zwar geht es jetzt darum.
Der AUgangspunkt ist wieder der selbe.
ca 200.txt dateien und zusätlich noch 200 csv datein´

Jeweils eine CSV Datei und eine txt datei sind zusammen in einem ordner.

Die CSV Datei hat den festen namen zusatzdaten.csv
die .txt datei hat immer die kundennummer als dateinamen und liegt auch im ordner mit der kundennummer.

ich möchte jetzt in einer neuen .xls datei in das zweite tabellenblatt in das Feld A1 eine Kundennummer eingeben und in Tabellenblatt 1 sollen sich dann die Verweise zu den Dateien ändern.
Also so z.B.
Ich gebe Kundennummer: 001 ein
Dann soll sich die Zelle A2 auf D:\MeinLaden\Daten\001\001.txt B4 beziehen. A3 auf B5 und A4 auf B6 ...bis A7.
Das ist sicherlich per Makro möglich.

Danach sollen noch werte aus der csv datei kopiert werden. Der Verwei ist nur im Ordnername variabel, die Datei heist immer Zusatzdaten.csv

Dort muss jedoch erst kurz der Text in Spalten geschrieben werden und dann wieder in mein neues Tabellenblatt muss in A8 die Zelle H1 aus Zusatzdaten.csv.


Ich denke das es am besten ist variable bezüge in die Zellen meines neuen Tabellenblatts ein zu geben, aber da weis ich leider noch nciht wie.
Zusätlich sollte das Makro natürlich die beiden entsprechenden öffnen, das die Zellen auch einen Bezug haben könnten.
Wenn das alles automatisch ablaufen würde, wäre es natürlich perfekt,
also txt und csv öffnen, csv wird der text in spalten geschrieben. werte werden aktualisiert, und die csv und txt wieder geschlossen ohne sie zu speichern (da die csv so bestehen bleiben muss).
Und danach soll dieses Blatt noch als txt gespeichert werden in einem vorgegeben ordner als dat_(Kundennummer).txt

Das wäre wunderbar wnen mir jeamnd helfen kann.

Hi,
also ich habe alles geschafft.
nur ich habe ein problem.
ich bekomme bei meiner exportierten txt datei in manchen zeilen so hässliche gänsefüschen.
kann ich das irgendwie abstellen