VBA Makro zum kopieren von Daten aus mehreren Dateien in einem Ordner

[btopdan]

Guten Morgen,

ich habe mit folgender Aufgabe zu kämpfen:

mein Makro soll bei allen in einem bestimmten Ordner befindlichen Exceldateien zwei Spalten herauskopieren und in meine Zusammenfassungsdatei einfügen. Ich denke ich bin auf dem richtigen Weg, jedoch wird ab der Zeile (Workbooks.Open Filename:=Dateiname), in der eine solche Datei geöffnet werden soll, der Laufzeitfehler 1004 aufgezeigt.
Bin für jede Hilfe dankbar.

Code:

Sub Auslesen()

   Dim Dateiname As String

   Set Ziel = ThisWorkbook.Worksheets("Statusmatrix Functions")

   Application.ScreenUpdating = False
   
       Dateiname = Dir$("Pfad...\*.xls")
       Spalte = 5
       
       Application.ScreenUpdating = False
               
           Do
               
               If Spalte = 1000 Then Stop
               
               Workbooks.Open Filename:=Dateiname
                     
               Workbooks(Dateiname).Range("E:F").Value = Workbooks(Ziel).Range(Spalte, Spalte + 1)
                                             
               Workbooks(Dateiname).Close
               
               Spalte = Spalte + 2
               
               Application.ScreenUpdating = True
           
           Loop Until Dateiname = ""
           
           

End Sub

   

[snb]

Code:

Sub M_snb()
 sn=split(createobject("wscript.shell").exce("cmd /c dir G:\OF\*.xls /b/s").stdout.readall,vbcrlf)
 
  for j=0 to ubound(sn)-1
   with getobject(sn(j))
      .sheets(1).usedrange.columns(5).resize(,2).copy thisworkbook.sheets(1).cells(1,columns.count).end(xltoleft).offset(,1)
      .close 0
    end with
   next
end sub
   

[btopdan]

Code:

Sub M_snb()
 sn=split(createobject("wscript.shell").exce("cmd /c dir G:\OF\*.xls /b/s").stdout.readall,vbcrlf)
 
 for j=0 to ubound(sn)-1
   with getobject(sn(j))
     .sheets(1).usedrange.columns(5).resize(,2).copy thisworkbook.sheets(1).cells(1,columns.count).end(xltoleft).offset(,1)
     .close 0
   end with
  next
end sub
   

Vielen Dank schonmal. Kannst du mir den Code eventuell ein wenig erklären? So fit bin ich noch nicht und sehe nicht exakt an welche stelle der pfad gehört

[btopdan]

Habe den Code mal versucht laufen zu lassen, das Ergebnis:
[
Bild bitte so als Datei hochladen: Klick mich!
]

[Wastl]

Moin

ein kleiner tippfehler:

sn=split(createobject("wscript.shell").exce("cmd /c dir G:\OF\*.xls /b/s").stdout.readall,vbcrlf)

 muss heißen
sn=split(createobject("wscript.shell").exec("cmd /c dir G:\OF\*.xls /b/s").stdout.readall,vbcrlf)

dann läufts
Der Pfad  kommt an die grüne Stelle

[RPP63]

Moin!
Der Shell-Befehl lautet .exec und nicht .exce
Wo steht der Pfad?
Du musst doch nur nach den Backslashes \ suchen.
Ob der Code funktioniert, habe ich nicht getestet.
Allgemein sind Codes von snb knackig kurz, für einen Laien aber nicht nachvollziehbar.
Wenn ihn jemand erklären wollte, würde es eine längere Geschichte.
Falls Du Zeit und großes Interesse hast, kannst Du mal nach [url=
Dateiupload bitte im Forum! So geht es: Klick mich!
script host tutorial[/url] suchen.

Gruß Ralf

[btopdan]

Ich danke allen vielmals, der Code läuft!

[btopdan]

Jetzt habe ich aber noch eine Frage, ist aber kein Muss:

Wenn jetzt eine Datei in den Quellordner dazu kommt, muss ich logischerweise das Makro noch einmal laufen lassen, jedoch kopiert es dann auch alles, was er bis zu dieser Datei bereits hatte. Kann ich das schnell beheben oder geht das in diesem Code nicht mehr?

[snb]

Dann kannst du diese Dateien löschen ?

Code:

Sub M_snb()
 sn=split(createobject("wscript.shell").exec("cmd /c dir G:\OF\*.xls /b/s").stdout.readall,vbcrlf)
 
 for j=0 to ubound(sn)-1
   with getobject(sn(j))
     .sheets(1).usedrange.columns(5).resize(,2).copy thisworkbook.sheets(1).cells(1,columns.count).end(xltoleft).offset(,1)
     .close 0
   end with
  next

   kill "G:\OF\*.xls"
end sub