Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Excel Dateien per Makro zusammenfassen und ordnen

Mitglied: JaZo27

JaZo27 (Level 1) - Jetzt verbinden

18.10.2013 um 15:03 Uhr, 8346 Aufrufe, 21 Kommentare

Hallo werte Forums-Community!

Ich habe momentan mit folgendem Problem zu kämpfen:

Ein Ausgangsordner C:\Users\JaZo27\TestName befinden sich Excel-Dateien, die alle aus einem Sheet bestehen und gleich aufgebaut sind. Ich würde nun gerne per Makro alle im Ordner befindlichen Excel-Dateien in einer Arbeitsmappe zusammenfassen. Jede importierte Datei in einem neuen Tabellenblatt. Zum Abschluss möchte ich gerne eine Liste erstellen, die bestimmte Werte aus den Tabellenblättern zusammenfasst.

Also in der Liste soll dann z.B in A3 der Wert von Tabelle1!C6 stehen, in C3 der Wert von Tabelle1!C33, usw.. in A4 dann Tabelle2!C6, usw

Ich habe mal per Aufzeichmakro erste Gehversuche gestartet, würde mich aber über eure Inputs sehr freuen.

Danke schonmal an alle die sich die Mühe machen meinen Beitrag zu lesen und gegebenenfalls auch zu antworten.

Gruss
JaZo27
Mitglied: bastla
18.10.2013, aktualisiert um 20:21 Uhr
Hallo JaZo27!

Das könnte anhand Deiner Beispieldaten etwa so gehen:
01.
Sub Zusammenfassen()
02.
Pfad = "D:\Dein Ordner"
03.
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")
04.
 
05.
Set Sammel = ThisWorkbook 'Sammeldatei merken
06.
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken
07.
Set fso = CreateObject("Scripting.FileSystemObject")
08.
 
09.
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen
10.
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln
11.
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten
12.
        If LCase(Datei.Name) <> SammelName And LCase(Datei.Name) <> "~$" & SammelName Then 'Sammeldatei nicht verarbeiten
13.
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken
14.
            Workbooks.Open Filename:=Datei.Path 'Datei öffnen
15.
            Sheets(1).Move After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen
16.
            Sammel.Sheets(Sammel.Sheets.Count).Name = Dateiname 'Namen des eingefügten Blattes auf den Dateinamen der Herkunftsdatei setzen
17.
            Workbooks(Datei.Name).Close (False) 'Datei schließen (ohne speichern)
18.
        End If
19.
    End If
20.
Next
21.
 
22.
With Sammel
23.
    Set Uebersicht = .Sheets(1) 'Übersichtstabelle merken
24.
    Versatz = AbZeile - 2 'für Berechnung Zeilennummer verwendet
25.
    For i = 2 To .Sheets.Count 'alle Blätter nach dem Übersichtsblatt durchgehen
26.
        BlattName = .Sheets(i).Name 'Blattnamen merken
27.
        'Formeln zum Übernehmen der Werte eintragen
28.
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A" im Übersichtsblatt) und zu übernehmende Zelle ("C6") anpassen
29.
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C" im Übersichtsblatt) und zu übernehmende Zelle ("C33") anpassen
30.
    Next
31.
End With
32.
End Sub
Du hast zwar die übernommenen Blätter "Tabelle1" und "Tabelle2" genannt, ich fände aber den Namen der Datei, aus der das Blatt stammt, informativer (lässt sich auf Wunsch aber natürlich wieder auf "Tabelle#" ändern) ...

Das Makro ist in die "Sammel"-Datei einzufügen und von dort aus zu starten.

Grüße
bastla
Bitte warten ..
Mitglied: JaZo27
21.10.2013 um 15:45 Uhr
Hallo bastla!

Vielen Dank für den Code!

Meine Überlegung bezüglich der Tabellennamen war folgende:

Die files haben zum Teil sehr lange Namen und ich war mir nicht sicher, wieviele Zeichen ein Reiter verträgt. Deswegen der Umweg über Tabelle1,2...

Ich gebe dir Recht, dass es informativer wäre, die Reiter nach den importierten Dateien zu benennen, aber beim Testen stellte sich heraus, nur 31 Zeichen pro Reiter. Schade.

Hab jetzt ein paar Dateien zum Testen umbenannt, konnte allerdings noch keinen Erfolg erzielen, da eine Fehlermeldung mit "Laufzeitfehler 9" erscheint. (Zeile 17)

Woran könnte das liegen?

Besten Dank für deine Hilfe

Gruss
JaZo27
Bitte warten ..
Mitglied: bastla
21.10.2013 um 19:30 Uhr
Hallo JaZo27!

Den Fehler kann ich nicht nachvollziehen, aber falls er weiterhin auftreten sollte, ersetze testweise die Zeile durch
Workbooks(Workbooks.Count).Close False
Für die Benennung der Tabellen mit einer fortlaufenden Bezeichnung / Nummer könntest Du folgende angepasste Variante versuchen:
01.
Sub Zusammenfassen()
02.
Pfad = "D:\Dein Ordner"
03.
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")
04.
 
05.
Set Sammel = ThisWorkbook
06.
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken
07.
Set fso = CreateObject("Scripting.FileSystemObject")
08.
 
09.
TabName = "Tabelle" 'konstanter Teil der neuen Tabellennamen
10.
Nr = 101 'Startwert für Nummer in den Tabellennamen
11.
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen
12.
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln
13.
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten
14.
        If LCase(Datei.Name) <> SammelName And LCase(Datei.Name) <> "~$" & SammelName Then 'Sammeldatei nicht verarbeiten
15.
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken
16.
            Workbooks.Open Filename:=Datei.Path 'Datei öffnen
17.
            Sheets(1).Move After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen
18.
            Sammel.Sheets(Sammel.Sheets.Count).Name = TabName & Nr 'Namen des eingefügten Blattes setzen
19.
            Nr = Nr + 1 'Nummer für Tabellennamen erhöhen
20.
            Workbooks(Datei.Name).Close (False)
21.
        End If
22.
    End If
23.
Next
24.
 
25.
With Sammel
26.
    Set Uebersicht = .Sheets(1)
27.
    Versatz = AbZeile - 2
28.
    For i = 2 To .Sheets.Count
29.
        BlattName = .Sheets(i).Name
30.
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A") und zu übernehmende Zelle ("C6") anpassen
31.
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C") und zu übernehmende Zelle ("C33") anpassen
32.
    Next
33.
End With
34.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: Biber
21.10.2013, aktualisiert 14.05.2014
Moin JaZo27 und bastla,

zu dem Problem der Länge des Reiternamens bzw, des Laufzeitfehlers 9 noch ein paar Hinweise.

- ja, die fest voreingestellte maximale Länge des Reiternamens ist bei allen Excelversionen 31 Zeichen.
- und es dürfen/sollten einige Zeichen nicht verwendet werden wie Doppelpunkt :, Schrägstrich (/) ,Backslash (\), Wildcards (? und *) oder ein Apostroph als erstes Zeichen
- ein Teil dieser Konventionen wird auch als Fehlermeldung angezeigt, wenn bei "Arbeitsblatt umbenennen" etwas derartiges eingegeben wird

Zusätzliche Hürde ist allerdings, dass die Redmonder schon seit jeher kleinere Probleme mit der Länge von Dateinamen haben und vor allem nicht mehr als zwei Summanden gleichzeitig bei einer Addition im Auge behalten können.

Deshalb kann der Laufzeitfehler auch verursacht werden durch die Gesamtlänge von (Laufwerk+Pfad+Dateiname der Exceldatei), die kleiner als 218 Zeichen plus der Länge eines Arbeitsblattnamen ( max. 31) + 3 ( ein bis drei Zeichen werden als Trenner zwischen Arbeitsmappennamen und Reiternamen benötigt).

Die Gesamtsumme der Einzelsummanden (= max217 plus max31 plus max3 ) wiederum darf nur 235 sein, sonst lassen sich keine Verknüpfungen zu diesen Tabellen anlegen.
Diese Rechenregel wird mal bekannt werden als "Redmondsche Algebra" oder "das Theorem der PraktikantInnen"

Deshalb solltest du, JaZo27, diese Exceldatei mal in einem "kurzen" Verzeichnis (D:\temp) daraufhin prüfen, ob der Laufzeitfehler auch dort auftritt.
Ich vermute nämlich, die Datei liegt bei dir im Moment unter "C:\Users\Dokumente und Einstellungen\noch\vierbisfünf\weitere\Ebenen\", bei bastla dagegen auf d:\Temp.

Wenn die Datei aber im "Echtbetrieb" auf einem ziemlich langen Dateinamen (z.B. ein Servershare) liegen muss, dann würde ich dieses Gesamtlängen-Limit im Hinterkopf behalten.

Grüße
Biber
Bitte warten ..
Mitglied: JaZo27
22.10.2013 um 08:59 Uhr
Guten Morgen bastla und Biber!

Danke für eure Hinweise.

Ich bin jetzt mal dem Tipp von Biber gefolgt und hab die Dateien in ein "kurzes" Verzeichnis kopiert und auch mit "kurzen" Namen benannt.

Wie mir scheint ist dies allerdings nicht die Ursache für den Laufzeitfehler 9, da er immer noch wie zuvor auftritt.

Der Versuch

Workbooks(Datei.Name).Close (False)

mit

Workbooks(Workbooks.Count).Close (False)

zu ersetzen hat auch nicht den gewünschten Erfolg erzielt. Die Arbeitsmappe wird dabei ganz geschlossen.

Die erste Datei des Ordners wird wie gewünscht eingefügt, beim Sprung auf die zweite Datei scheint irgendwo der Fehler zu liegen.


Vielen Dank für eure Bemühungen und schönen Tag!
Gruss
JaZo27
Bitte warten ..
Mitglied: bastla
23.10.2013 um 16:31 Uhr
Hallo JaZo27!

Unabhängig davon, dass (ohne konkrete Beispiele für die von Dir verwendeten Dateinamen etwas schwierig zu testen) der genannte Fehler bei mir weiterhin nicht auftritt: Hast Du es schon mit meinem zweiten Ansatz versucht?

Grüße
bastla
Bitte warten ..
Mitglied: Biber
23.10.2013, aktualisiert 14.05.2014
Hmm,

Sir Arthur C. Doyle lässt doch mal seinen Protagonisten sinngemäß sagen:
"Wenn alle andere anderen Möglichkeiten ausgeschlossen werden, dann muss es die letzte verbleibende sein - wie unwahrscheinlich diese auch sein mag."

Ich tippe deshalb auf folgendes Szenario:
- bei irgendeinem Testlauf/Skriptabbruch ist eine der zu verarbeitenden (Quell-)Excel-Dateien nicht geschlossen worden und hat deshalb noch eine temporäre Datei im Verszeichnis stehen lassen (zum Zeichen, dass jemand diese gerade editiert.). Name dieser temporären Datei ist sowas wie "~$"+erkennbar viel vom Dateinamen plus Extension xls/xls?"

- da diese Datei nicht weggefiltert wird im For-Each-Konstrukt wird sie dann auch "als normale Exceldatei" geöffnet - und beim Schliessen geht natürlich jedes Workbook.Close auf die Bretter,


Verifizieren liesse sich das, wenn mal vor der Absturz-Zeile eine Ausgabe des Dateinamens erfolgen würde:
01.
   ...
02.
  Debug.Print "Dateiname = " & Datei.Name & " bzw "  & ActiveWorkbook.Name 
03.
  Workbooks(Datei.Name).Close (False) ...
04.
 
Abstellen liesse es sich, wenn diese Zeile
.. IF ... And LCase(Datei.Name) <> "~$" & SammelName Then

... sinngemäß geändert werden würde auf
..IF ... And Substr(Datei.Name, 1, 2 ) <> "~$" Then



Wenn die Ursache noch abgedrehter ist, dann habe ich auch keine Idee mehr.

Grüße
Biber
Bitte warten ..
Mitglied: bastla
23.10.2013 um 18:18 Uhr
... wobei sich in VBx für derlei die Schreibweise
If LCase(Datei.Name) <> SammelName And Left(LCase(Datei.Name), 1) <> "~" Then 'Sammeldatei nicht verarbeiten
bewährt hat ...

Grüße
bastla
Bitte warten ..
Mitglied: Biber
23.10.2013 um 18:29 Uhr
.... warum muss denn der arme VBS-Schnipsel auf die Tilde ein LCase() machen?
Ginge auch ein UCase()?


Grüße zurück
Biber
Bitte warten ..
Mitglied: bastla
23.10.2013 um 18:36 Uhr
@ Biber
.... warum muss denn der arme VBS-Schnipsel
Damit er's mal zum VBA-Schnipsel bringt?

Aber klar: Egal ob "LCase" oder "UCase" - Käs' isses hier auf jeden Fall ...

Grüße
bastla
Bitte warten ..
Mitglied: Biber
23.10.2013 um 18:54 Uhr
@ bastla

...viellleicht implementieren die PraktikantInnen uns ja noch ein "ICase" ( nein, kein Walfischleder-Etui fürs iPhone, sondern ein "IgnoreCase").

Aber bis dahin ist bestimmt aus "Visual Basic for Applications" schon ein "Visual Basic for Widgets" geworden...

Ich werde mir auch deine Schreibweise "VBx" angewöhnen.

Grüße
Biber
Bitte warten ..
Mitglied: bastla
23.10.2013 um 19:02 Uhr
@ Biber
...vielleicht implementieren die PraktikantInnen uns ja noch ein "ICase"
Naja, StrComp() mit der Option vbTextCompare wäre zwar etwas in der Art, ist mir aber (aus noch nicht geklärten Gründen ) irgendwie unsympathisch ...

Grüße
bastla
Bitte warten ..
Mitglied: Biber
23.10.2013, aktualisiert um 20:31 Uhr
@ bastla

Das wär auch nix für mich....

Wie du schon festgestellt hast - diese LKäs' und UKäs'-Funktionen klingen sympathisch - diese Laute könnten dir auch in Stogart oder Hesse zu Ohren kommen und "UKäs'" sogar in der Fernsehwerbung ("... der leichte You-Käs mit linksdrehenden Kolibakterien...").


Aber "strComp()" klingt ja schon, als hätte ich das Mittagessen bei meiner Ex-Schwiegermutti probiert...

Grüße
Biber
Bitte warten ..
Mitglied: JaZo27
24.10.2013, aktualisiert um 08:54 Uhr
Hallo bastla, hallo Biber!


@ bastla

Ja ich habe auch den zweiten Ansatz schon versucht, leider mit dem gleichen Ergebnis: Laufzeitfehler 9

Die Dateien sind wie folgt benannt 1234AB_Name_Zusatzinfo.xls. Name sowie Zusatzinfo haben unterschiedliche Länge: 5678DC_Ganzlangername_13_2_9, 1245F_Name_5, usw.


@ Biber

Ich hab mal die Zeile mit dem

Debug.Print "Dateiname = " & Datei.Name & " bzw " & ActiveWorkbook.Name

eingefügt, mir ist allerdings nicht ganz klar, wo die Ausgabe des Namens erfolgt?


Bitte verzeiht mein Unwissen, aber es handelt sich hier um meine ersten Versuche in VBA

Danke für eure Vorschläge
Grüsse
JaZo27
Bitte warten ..
Mitglied: bastla
24.10.2013 um 10:33 Uhr
Hallo JaZo27!

Ändere Zeile 14 auf
If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" Then 'Sammeldatei und Temp-Dateien nicht verarbeiten
... wo die Ausgabe des Namens erfolgt?
Im "Direktfenster" (Menü "Ansicht" bzw Strg-G; angezeigt wird als Fenstertitel "Direktbereich") des VBA-Editors ...

Grüße
bastla
Bitte warten ..
Mitglied: JaZo27
24.10.2013 um 14:04 Uhr
Hallo bastla!

Im Direktfenster erscheint

Dateiname = 1234AB_Kopie von Testname.xls bzw Zusammenfassung_Liste.xlsm

und wieder der schon bekannte Laufzeitfehler 9.

Guss
JaZo27
Bitte warten ..
Mitglied: Biber
24.10.2013, aktualisiert um 17:09 Uhr
Moin JaZo27,

hmm, eine Idee hätte ich noch - nämlich wenn bei bastlas Tests alle Arbeitsmappen plus die Sammelmappe in einem Verzeichnis liegen und bei deinem Szenario alle Quell-Dateien in einem und die Sammelmappe in einem anderen.

Dann spendieren wir noch eine Variable mehr aus Ängstlichkeit:

01.
Sub Zusammenfassen()
02.
Pfad = "D:\Dein Ordner"
03.
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")
04.
 
05.
Set Sammel = ThisWorkbook
06.
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken
07.
Set fso = CreateObject("Scripting.FileSystemObject")
08.
 
09.
TabName = "Tabelle" 'konstanter Teil der neuen Tabellennamen
10.
Nr = 101 'Startwert für Nummer in den Tabellennamen
11.
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen
12.
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln
13.
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten
14.
        If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" & SammelName Then 'Sammeldatei und Temp-Dateien nicht verarbeiten
15.
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken
16.
            ' # ##alt  Workbooks.Open Filename:=Datei.Path 'Datei öffnen
17.
            Set nextWb = Workbooks.Open(Datei.Path)  'nächste Import-Datei öffnen und nextWb zuweisen
18.
            '  # ##alt  Sheets(1).Move After ....
19.
            nextwB.Sheets(1).Copy After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen
20.
            Sammel.Sheets(Sammel.Sheets.Count).Name = TabName & Nr 'Namen des eingefügten Blattes setzen
21.
            Nr = Nr + 1 'Nummer für Tabellennamen erhöhen
22.
           '  # ##alt              Workbooks(Datei.Name).Close (False)
23.
            nextwB.Close (False)
24.
        End If
25.
    End If
26.
Next
27.
 
28.
With Sammel
29.
    Set Uebersicht = .Sheets(1)
30.
    Versatz = AbZeile - 2
31.
    For i = 2 To .Sheets.Count
32.
        BlattName = .Sheets(i).Name
33.
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A") und zu übernehmende Zelle ("C6") anpassen
34.
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C") und zu übernehmende Zelle ("C33") anpassen
35.
    Next
36.
End With
37.
End Sub
Jeweils die Zeilen unterhalb der drei Zeilen mit " ' # ##alt " sind - bezogen auf bastlas oben geposteten Code - anzupassen.

Wenn es das auch nicht ist, dann müssen wir mal warten, bis ein Experte hier vorbeikommt.

Grüße
Biber
Bitte warten ..
Mitglied: RambaZamba
09.05.2014, aktualisiert um 14:46 Uhr
Heho Bastla und Biber,

ich versuche seit einer Weile einen Makro zu finden, mit dem ich aus einem Ordner mehrere Excel-Datein in ein Datenblatt einer Sammeldatei untereinander schreiben kann. Eure hier angegebene Lösung kommt dem denke ich schon sehr nach, wobei ich denke das meine Vorstellungen ja eigentlich einfacher sind. Nur leider weiß ich nicht, wie ich die ausgelesenen Daten untereinander schreiben kann.
In den auszulesenden Excel-Datein gibt es immer nur ein Datenblatt mit dem gleichen Aufbau, wobei die Zeilen jedoch variieren können.
Ich wäre über jede Hilfe sehr dankbar.

Liebe Grüße
Ramba
Bitte warten ..
Mitglied: bastla
09.05.2014, aktualisiert um 22:07 Uhr
Hallo RambaZamba und willkommen im Forum!

Das könnte etwa so gehen:
01.
Sub Zusammenfassen()
02.
Pfad = "D:\Dein Ordner"
03.
QAbZeile = 1 'ab dieser Zeile die Daten auslesen
04.
ZAbZeile = 3 'ab dieser Zeile die Daten eintragen
05.
 
06.
Set Sammel = ThisWorkbook 'Sammeldatei merken
07.
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken
08.
Set SammelBlatt = Sammel.Sheets(1) 'Sammel-Tabelle merken
09.
Set fso = CreateObject("Scripting.FileSystemObject")
10.
 
11.
ZZeile = ZAbZeile 'Startzeile für Sammelblatt übernehmen
12.
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen
13.
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln
14.
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten
15.
        If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" Then 'Sammeldatei und Temp-Dateien nicht verarbeiten
16.
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken
17.
            Set nextWb = Workbooks.Open(Datei.Path) 'nächste Quell-Datei öffnen und nextWb zuweisen
18.
            QZeile = QAbZeile 'Startzeile für Quelldatei setzen
19.
            With nextWb.Sheets(1) 'mit dem 1. Blatt der Quelldatei arbeiten
20.
                Do While .Cells(QZeile, "A") <> "" 'solange in Spalte A Werte stehen
21.
                    .Rows(QZeile).EntireRow.Copy SammelBlatt.Cells(ZZeile, "A") 'ganze Zeile kopieren
22.
                    QZeile = QZeile + 1 'Zeilennummer Quelldatei erhöhen
23.
                    ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen
24.
                Loop
25.
            End With
26.
            nextWB.Close (False) 'Quelldatei schließen
27.
        End If
28.
    End If
29.
Next
30.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: RambaZamba
09.05.2014 um 18:01 Uhr
Hey Bastla,

es funktioniert überragend! So wie ichs mir vorgestellt habe. Du hast mir echt eine ganz schöne Arbeit ersparrt. Wäre mit meinen VBA-Kentnissen echt baden gegangen. Vielen Dank für die schnelle Hilfe.

Grüße Ramba
Bitte warten ..
Mitglied: bastla
09.05.2014 um 22:08 Uhr
Hallo RambaZamba!

Freut mich, wenn's hilft ...

Grüße
bastla
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Excel-Makro
gelöst Frage von yuki13Microsoft Office7 Kommentare

Hallo Zusammen!! :-) Ich bin nicht so fit in Excel Makros und wollte mich hier erkundigen, ob mir jemand ...

Microsoft Office
Excel Makro
Frage von maloh1984Microsoft Office4 Kommentare

Hallo Habe ein Problem, ein Kunde der hat Excellisten mit Makro die lassen sich öffnen aber die Buttons reagieren ...

Microsoft Office
Excel Makro Hilfe
gelöst Frage von freshman2017Microsoft Office8 Kommentare

Moin Moin! Ich würde gerne mit Excel - Kombinationen für Artikelnummern erstellen. Könnte hierbei bereits heraus finden, dass ein ...

Microsoft Office
Excel Button Makro
gelöst Frage von Florian86Microsoft Office3 Kommentare

Hallo, ich habe folgendes Problem. Wir haben uns einige Buttons erstellt und mit Macros hinterlegt. Jetzt gibt es einen ...

Neue Wissensbeiträge
Humor (lol)
Administrator.de Perlen
Tipp von DerWindowsFreak2 vor 2 TagenHumor (lol)3 Kommentare

Hallo, Heute beim stöbern auf dieser Seite bin auf folgenden Thread aus dem Jahre 2006 gestossen: Was meint ihr? ...

Erkennung und -Abwehr
OpenSSH-Backdoor Malware erkennen
Tipp von Frank vor 2 TagenErkennung und -Abwehr

Sicherheitsforscher von Eset haben 21 Malware-Familien untersucht. Die Malware soll Hintertüren via OpenSSH bereitstellen, so dass Angreifer Fernzugriff auf ...

iOS
WatchChat für Whatsapp
Tipp von Criemo vor 6 TageniOS5 Kommentare

Ziemlich coole App für WhatsApp User in Verbindung mit der Apple Watch. Gibts für iOS sowohl als auch für ...

iOS
IOS hat nen Cursor!
Tipp von Criemo vor 6 TageniOS5 Kommentare

Nette Funktion im iOS. iPhone-Mauszeiger aktivieren „Nichts ist nerviger, als bei einem Tippfehler zu versuchen, den iOS-Cursor an die ...

Heiß diskutierte Inhalte
Grafikkarten & Monitore
PCIe 1.0 Grafikkarte für 3840x2160
Frage von Windows10GegnerGrafikkarten & Monitore29 Kommentare

Hallo, mein Vater hat einen neuen Monitor gekauft, welcher eine native Auflösung von 3840*2160 hat. Diese muss jetzt auch ...

Windows 10
Windows Enterprise 1809 Eval nicht bootbar
Frage von Sunny89Windows 1022 Kommentare

Hallo zusammen, bevor ich mich jetzt noch stundenlang rumärger wollte ich euch fragen, ob Ihr die gleichen Probleme habt ...

Windows Server
Dienstnamen und oder Deutsche und Englische Beschreibung in services.msc gleichzeitig anzeigen
gelöst Frage von vafk18Windows Server17 Kommentare

Guten Morgen, die Suche nach Diensten in services.msc gestaltet sich immer wieder schwierig, weil mir je nach Aufgabe die ...

Linux
Info Monitor für eine Schule
gelöst Frage von CAT404Linux13 Kommentare

Moin, ich möchte einen Infomonitor betreiben; derzeit läuft da ein Windows 10 Rechner bei dem Firefox beim Start in ...