Clever-Excel-Forum

Seiten: 1 2

Hallo liebes Forum!

Ich habe (quasi täglich) einen (neuen) Ordner mit 50-100 Excellisten.

Diese Liste haben alle nur wenige Zeilen und alle dieselben Spalten A-Z.

Diese manuell zu einer Datei zusammenzufügen ist immer recht mühselig ...

Gibt es eine Möglichkeit diese "in einem Rutsch" zusammenzufügen?

Also ich würde alle neuen Listen z.B. in den Ordner C:\Users\Name\Documents\All-in-one packen, (nachdem ich die alten rausgenommen habe) und dann quasi per Knopfdruck eine Gesamtdatei erzeugen, die auch in diesen Ordner gespeichert wird.

Vielen Dank für eure Hilfe ...

Robert

Moin,

probiere es doch mal mittels Daten - Daten abrufen - Aus Datei - Aus Ordner - Daten Tansformieren und kombinieren

Hallo

Möchtest du für jede Datei in der Zusammenfassung einen eigenen Reiter erstellen, oder sollen die vorhandenen Daten in Einem Reiter (Tabellenblatt) alle untereinander eingetragen werden ?

Haben die Einzeldaten jeweils eine Überschrift?

LG UweD

Hi Stoffo ...

Ich habe:

Daten - Neue Abfrage - Aus Datei - Aus Ordner - Daten Tansformieren und kombinieren habe ich nicht ... nur bearbeiten

Moin,

schau mal hier unter Importieren aus Excel oder Access:

Link

Je nachdem bei welchem Schritt ein Problem auftritt kannst du dich dann ja nochmal melden.

Hallo Uwe ...

Danke das Du (nach-)gefragt hast.

Die vorhandenen Daten sollen in einem Reiter (Tabellenblatt) alle untereinander eingetragen werden.

Die Bezeichnungen an sich sind immer gleich ... nur kommen manche in manchen Dateien nicht vor.

Aber die 5 Spalten die ich eigentlich nur benötige kommen immer vor.

Die ersten drei sind immer in Spalte B, C, D nur die letzten beiden mal in E, mal in F oder G ...

Könnte man auch nur diese 5 immer gleich bezeichneten Spalten auslesen und zusammenführen?

Hallo nochmal

so?

Code:
Option Explicit

Sub Zusammen1()

    Dim TBZ As Worksheet

    Dim Pfad As String, Datei As String, Ext As String

    Dim Spalte As Integer, LRZ As Long, LRx As Long, Z1 As Integer

    Dim SW, I As Integer, Anz As Integer

    Set TBZ = ThisWorkbook.Sheets("Tabelle1") ' Zieltabelle

    Z1 = 2 'ggf wegen Überschrift

    'Suchworte für Spalte 4 und 5

    SW = Array("ABC", "DEF")

    Pfad = "C:\Users\Name\Documents\All-in-one"

    Ext = "*.xlsx"

    Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\") 'sicherstellen, dass \ am Ende

    Datei = Dir(Pfad & Ext)

    Application.ScreenUpdating = False 'Schaltet flackern ab

    'Reset

    TBZ.Cells.Delete

    Do While Datei <> ""

        Workbooks.Open Filename:=Pfad & Datei

        With ActiveWorkbook.Sheets(1)

            LRx = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte

            LRZ = TBZ.Cells(TBZ.Rows.Count, "B").End(xlUp).Row + 1

            'B2:D.. Kopieren in

            .Cells(Z1, 2).Resize(LRx - Z1 + 1, 3).Copy TBZ.Cells(LRZ, 2)

            For I = LBound(SW) To UBound(SW) ' Schleife für Suchworte (0 bis 1)

                'Spalte suchen

                If WorksheetFunction.CountIf(.Rows(1), SW(I)) > 0 Then

                    Spalte = WorksheetFunction.Match(SW(I), .Rows(1), 0)

                    'kopieren

                    .Cells(Z1, Spalte).Resize(LRx - Z1 + 1, 1).Copy TBZ.Cells(LRZ, 5 + I) 'Rest Kopieren in E und F

                Else

                    MsgBox "In Datei: " & Datei & " wurde Suchwort " & SW(I) & " nicht gefunden"

                End If

            Next

            Anz = Anz + 1

        End With

        Workbooks(Datei).Close False

        ' wenn gewünscht Datei nachher löschen

        'Kill Pfad & Datei

        Datei = Dir() ' nächste Datei

    Loop

    MsgBox Anz & " Dateien zusammengefügt"

End Sub

LG UweD

Hallo Uwe ...

das sieht ja wahnsinnig erfolgversprechend aus.

Wenn ich das richtig deute werden die Spalten B, C und D immer genommen richtig?

Und die Suchworte = Überschriften für die Ergebnisspalte 4 und 5 ersetze ich bei "ABC" und "DEF" richtig?

Nur wie bekomme ich diesen Code dann zum Laufen?

Hallo

ja genau.

- Alt+F11 startet den VB Editor
- dort Einfügen, Modul
- rechts den Code einfügen

- VBEditor kannst du wieder schließen

- Über Alt+F8 lässt du dir die Makros anzeigen
- "Zusammen1" kannst du dann markieren
- Entweder direkt AUSFÜHREN
- Oder über die OPTIONEN einer Tastenkombi zuordnen
- Oder einen Button erzeugen und das Makro zuweisen.

LG

Hi Uwe ...

Danke für die verständliche Anleitung.

Ich habe das Einfügen des Codes geschafft und auch die ersten Fehlermeldungen überwunden, nur jetzt komme ich nicht weiter ...

Laufzeitfehler: 1004

Die Zeile markiert mir der Debugger gelb:

.Cells(Z1, 2).Resize(LRx - Z1 + 1, 3).Copy TBZ.Cells(LRZ, 2)

1. Der Pfad zum Ordner ist und der Name des Ordners sind korrekt?
2. Die zusammenzuführenden Dateien sind in diesem Ordner
3. Die Zieldatei Tabelle1 ist auch in diesem Ordner?
4. Die Suchworte 4&5 habe ich umbenannt
5. Die Datei mit dem Makro habe ich "Makro" genannt, auch in diesem Ordner

P.S. "Name" im Pfad ist natürlich nur ein Platzhalter ...

Code:
Option Explicit

Sub Zusammen1()

    Dim TBZ As Worksheet

    Dim Pfad As String, Datei As String, Ext As String

    Dim Spalte As Integer, LRZ As Long, LRx As Long, Z1 As Integer

    Dim SW, I As Integer, Anz As Integer

    Set TBZ = ThisWorkbook.Sheets("Tabelle1") ' Zieltabelle

    Z1 = 2 'ggf wegen Überschrift

    'Suchworte für Spalte 4 und 5

    SW = Array("location-contacts", "ng-binding 3")

    Pfad = "C:\Users\Name\Documents\All-in-one"

    Ext = "*.xlsx"

    Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\") 'sicherstellen, dass \ am Ende

    Datei = Dir(Pfad & Ext)

    Application.ScreenUpdating = False 'Schaltet flackern ab

    'Reset

    TBZ.Cells.Delete

    Do While Datei <> ""

        Workbooks.Open Filename:="C:\Users\Name\Documents\All-in-one\Tabelle1"

        With ActiveWorkbook.Sheets(1)

            LRx = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte

            LRZ = TBZ.Cells(TBZ.Rows.Count, "B").End(xlUp).Row + 1

            'B2:D.. Kopieren in

            .Cells(Z1, 2).Resize(LRx - Z1 + 1, 3).Copy TBZ.Cells(LRZ, 2)

            For I = LBound(SW) To UBound(SW) ' Schleife für Suchworte (0 bis 1)

                'Spalte suchen

                If WorksheetFunction.CountIf(.Rows(1), SW(I)) > 0 Then

                    Spalte = WorksheetFunction.Match(SW(I), .Rows(1), 0)

                    'kopieren

                    .Cells(Z1, Spalte).Resize(LRx - Z1 + 1, 1).Copy TBZ.Cells(LRZ, 5 + I) 'Rest Kopieren in E und F

                Else

                    MsgBox "In Datei: " & Datei & " wurde Suchwort " & SW(I) & " nicht gefunden"

                End If

            Next

            Anz = Anz + 1

        End With

        Workbooks(Datei).Close False

        ' wenn gewünscht Datei nachher löschen

        'Kill Pfad & Datei

        Datei = Dir() ' nächste Datei

    Loop

    MsgBox Anz & " Dateien zusammengefügt"

End Sub

Seiten: 1 2

RobertH

Stoffo

UweD

RobertH

Stoffo

RobertH

UweD

RobertH

UweD

RobertH