Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte aus mehreren Dateien kopieren per Makro

Werte aus mehreren Dateien kopieren per Makro
18.07.2006 14:36:27
Steffi
Hallo,
ich mache grade ein Praktikum und arbeite an einer Datenabfrage.
Diese Abfrage läuft über ein standardisiertes Template.
Die Kunden füllen dieses Template aus und schicken es an mich zurück.
Ich muss nun alle diese templates zusammenkopieren in eine Tabelle, die dann über ein Pivot ausgewertet werden kann.
Das ganze soll so funktionieren:
1. Ich speichere alle eingehenden Templates in einem Ordner
2. Ich starte mein Makro
3. Das Makro fragt mich, in welchem Ordner die Dateien liegen und ich nenne ihm den Ordner
4. Das Makro kopiert aus den eingegangenen Dateien die verschiedenen Zellen nebeneinander in die unterschiedlichen Spalten.
Das wäre es eigentlich schon. Wichtig wäre es, dass er eben immer in eine Zeile kopiert, die noch nicht belegt ist.
Die eingegangenen Templates, etc. sollen nach Möglichkeit nicht alle von mir geöffnet werden müssen. Auch am ende sollen alle wieder automatisch geschlossen werden, da es doch recht viele werden können und ich die sonst alle mit der Hand anklicken muss.
Herzlichen Dank für Eure Hilfe...
Danke, danke...
Liebe Grüße
Steffi
Außerdem soll das Makro so konzipiert sein, dass

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte aus mehreren Dateien kopieren per Makro
ransi
Hallo
Das ganze soll so funktionieren:
1. Ich speichere alle eingehenden Templates in einem Ordner
OK.
2. Ich starte mein Makro
OK.
3. Das Makro fragt mich, in welchem Ordner die Dateien liegen und ich nenne ihm den Ordner
Das geht so:


Option Explicit
Sub Ordner_suchen()
Dim dat
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
   .Title = "Such schön...."
   .InitialFileName = "C:\" 'oder was auch immer
              If .Show = -1 Then MsgBox .SelectedItems(1)
    End With
End Sub


4. Das Makro kopiert aus den eingegangenen Dateien die verschiedenen Zellen nebeneinander in die unterschiedlichen Spalten.
Da stellen sich jetzt allerdings einige Fragen:
Was meinst du hiermit?
"die verschiedenen Zellen nebeneinander in die unterschiedlichen Spalten."
Unklar ist auch dies:
"Wichtig wäre es, dass er eben immer in eine Zeile kopiert, die noch nicht belegt ist."
ransi
Anzeige
AW: Werte aus mehreren Dateien kopieren per Makro
18.07.2006 15:22:51
Steffi
Hallo,
herzlichen Dank schon mal!!!!
Nochmal kurz zu dem, was du mir schon geschickt hast. DANKE!!!
Es funktioniert super, dass das Ordnersuchfenster aufgeht. Und was muss ich nun weiter tun, damit er alle Dateien in dem Ordner nimmt und diese dann zusammenkopiert?
Jetzt zu deinen Fragen:
:::Da stellen sich jetzt allerdings einige Fragen:
:::Was meinst du hiermit?
:::"die verschiedenen Zellen nebeneinander in die unterschiedlichen Spalten."
In dem Template ist es immer so, dass z.B. im Feld A1 eine Überschrift steht und im Feld B1 dann Werte vom Kunden eingefügt wurden.
Die Überschriften aller Felder habe ich bereits in meine Ergebnisliste eingefügt, so dass er nur noch der Reihe nach die Spalten befüllen muss. Ist das so klar beschrieben?
Ich glaub ich hänge einfach mal ein Beispiel an...
https://www.herber.de/bbs/user/35182.xls
:::Unklar ist auch dies:
:::"Wichtig wäre es, dass er eben immer in eine Zeile kopiert, die noch nicht belegt ist."
Das heißt nur, dass wenn ich die Daten aus zwei Templates zusammenkopiere, dass diese DAten dann auch in zwei Zeilen untereinander stehen und sich nicht gegenseitig überschreiben.
Herzlichen Dank!!!
Liebe Grüße
Steffi
Anzeige
Rückfrage
ransi
Hallo
In den Templates stehen die werte immer im selben Tabellenblatt in den Zellen
B4,D4,F4 ?
Das sind die einzigen Einträge die das Template enthält ?
ransi
AW: Rückfrage
18.07.2006 16:13:32
Steffi
Hm, also die Daten stehen in allen Templates in den gleichen Feldern. Das Template war beim Rausschicken an die Kunden zum Teil gesperrt, so dass keine Änderung der Zeilen, etc. möglich war.
Allerdings sind es im Originaltemplate schon ein paar mehr Einträge. Leider darf ich das hier nicht online stellen aus Vertraulichkeitsgründen, hat mir mein Chef gesagt.
Insgesamt sind es im Originaltemplate so ungefähr 50 Einträge.
Herzlichen Dank!!!!
Steffi
Anzeige
AW: Rückfrage
18.07.2006 16:25:39
Steffi
Ich hab hier ein Makro im Internet gefunden. Könnte man das irgendwie brauchen dafür?
Ich fand das mit dem Ordner auswählen vorhin bei dir so gut, dass da ein Fenster aufgeht...

Sub test()
z = 2
Set DateiSuche = Application.FileSearch
With DateiSuche
.LookIn = "n:\test" 'Pfad anpassen
.Filename = "*.xls" 'Dateiname muss mit .xls enden
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
ThisWorkbook.Sheets(1).Cells(z, 1) = Sheets(1).Range("A1").Value
ThisWorkbook.Sheets(1).Cells(z, 2) = Sheets(2).Range("A1").Value
ThisWorkbook.Sheets(1).Cells(z, 3) = Sheets(3).Range("A1").Value
'damit werden jeweils die Werte der Zellen A1 der Tabellen 1-3 in _
dieses Workbook Tabelle1 A-C geschrieben. _
Kannst du erweitern und anpassen.
z = z + 1
ActiveWorkbook.Close savechanges:=False
Next i
End If
End With
End Sub

Anzeige
Beschreibung und Anpassung?
18.07.2006 18:21:33
Steffi
Hallo,
das funktioniert ja schon mal echt gut. Danke!!!!
Würdest du mir vielleicht einen Gefallen tun und das Makro kurz beschreiben, damit ich weiß, wo da was abläuft (sorry, ich bin da nicht so fit!) und ich dann auch weiß, was ich wo ändern muss, damit ich meine 50 Einträge einbinden kann?!
Liebe Grüße
Steffi
Nachtrag
18.07.2006 18:25:02
Steffi
Hier noch kurz ein Nachtrag. Hoffe, das geht jetzt noch.
Die Ergebnisliste habe ich schon vorformattiert. Das heißt, die Überschriften, etc. habe ich schon eingefügt und farblich markiert, etc.
Von daher sollten einfach nur die eingegebenen Werte (und nicht auch die Überschriften) in das Ergebnisblatt ab Zeile 5 kopiert werden.
Sorry, dass ich das vorher nicht schon geschrieben habe. Tut mir echt leid. :(
Trotzdem ganz lieben Dank...
Steffi
Anzeige
Versuch einer Erklärung
ransi
Guten Morgen


Sub Ordner_suchen()
Dim dat
Dim ordner
Dim datein
Dim fso
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Ein Array mit 65536 Zeilen und 3 Spalten.
'Dient zur späteren Aufnahme der Werte.
Dim arr(65536, 3)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Dim L As Long
Dim Z As Long
Dim WB
Dim dsplalert As Boolean
Dim cal
Dim scrup As Boolean
Dim ev As Boolean
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Zum Beschleunigen des Makros
With Application
    dsplalert = .DisplayAlerts
    cal = .Calculation
    scrup = .ScreenUpdating
    ev = .EnableEvents
    .DisplayAlerts = False              'Excelinterne Meldungen aus
    .Calculation = xlCalculationManual  'Automatische Berechnung aus
    .ScreenUpdating = False             'Bildschirm aktualisierung aus
    .EnableEvents = False               'Makrostarts aus
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXX
'Überschriften ins Array schreiben
arr(L, 0) = "Kundennummer"
arr(L, 1) = "Name"
arr(L, 2) = "Ort"
L = L + 1
'XXXXXXXXXXXXXXXXXXXXXXXXXXX
'Dialog aufrufen
'Die innere IF-Then Konstruktion fängt "Abbrechen" in dem Dialog ab.
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
   .Title = "Such schön...."
   .InitialFileName = "C:\" 'oder was auch immer
nochmal:
If .Show = -1 Then
    ordner = .SelectedItems(1)
Else:
    If MsgBox("Ordner auswählen vergessen." & vbCrLf & "Nochmal ?", vbYesNo) = vbYes Then
    GoTo nochmal
    Else:
        GoTo raus
    End If
End If
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Zugriff aus Dateisystem
Set fso = CreateObject("Scripting.filesystemobject")
Set datein = fso.getfolder(ordner)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Sucht jedes file in Ordner.
'i istdie Variable
For Each WB In datein.Files
    If WB.Name Like "*.xls" Then 'selbserklärend
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
        Workbooks.Open WB        'selbserklärend
        'Jetzt wird die eigentliche Arbeit gemacht.
        'z ist eine Variable über Zeilen.
        'Sheets(1).Range("a65536").End(xlUp).Row ist die
        'Zeilennummer der letzten beschriebenen Zelle in SpalteA
        'von WB.sheets(1).
        For Z = 2 To Sheets(1).Range("a65536").End(xlUp).Row
                arr(L, 0) = Sheets(1).Cells(Z, 1).Text
                'schreibt den Wert aus cells(zeile=z,Spalte=1) ins Array an Position
                'Zeile=2 und Spalte =1
                arr(L, 1) = Sheets(1).Cells(Z, 3).Text
                'schreibt den Wert aus cells(zeile=z,Spalte=3) ins Array an Position
                'Zeile=2 und Spalte =2
                arr(L, 2) = Sheets(1).Cells(Z, 5).Text
                'schreibt den Wert aus cells(zeile=z,Spalte=5) ins Array an Position
                'Zeile=2 und Spalte =3
                L = L + 1
        Next
        Workbooks(WB.Name).Close False
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
    End If
Next
Range("A:C") = arr 'Alle Werte auf einmal in die Tabelle übertragen
raus:
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Die Eingangs gemachten Einstellungen Rückgängig machen
With Application
     .DisplayAlerts = dsplalert
     .Calculation = cal
     .ScreenUpdating = scrup
     .EnableEvents = ev
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Sub


Wenn du mit dem Anpassen nicht klarkommst, mach doch bitte nochmal eine
Beispielmappe.
Blatt 1 und Blatt 2 sollten den Originalaufbau eines Templates enthalten.
Schreib da einfach irgendwelche Fantasiewerte in die Zellen.
Blatt 3 sollte dein fertig formatiertes Auswerteblatt sein.
Mit den Einträgen aus Blatt 1 und 2 drin.
Ich habe deine Tabellenstrukturen glaub ich nicht richtig verstanden.
ransi
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige