115 Aufrufe
Gefragt in Tabellenkalkulation von vbazh Einsteiger (24 Punkte)
Hallo Zusammen

Wie kann ich mehreren Excel Dateien, alle haben eine Tabelle und die Tabellen gleich augebaut sind, gleiche Kollonenzahl, aber beim allen hat Arbeitsblatt andere Namme.

Pfad Verzeichnis lautet= C:\Users\r.s\Baza

In diesem Ordner sind dann mehrere Tabellen die alle am Anfang gleich heissen

search100_ Blumen_

Endungen sind dann unterschiedlich.

Kann mir jemand da helfen?

Vielen Dank

10 Antworten

+1 Punkt
Beantwortet von m-o Profi (12.2k Punkte)

Hallo,

das folgende Makro gehört in ein Standardmodul (siehe hier: http://www.excelbeispiele.de/Modul.htm) deiner Arbeitsmappe, in der du die einzelnen Tabellen zusammenführen willst:

Sub Dateien_oeffnen()
Dim DateiName As String
Dim strPfad As String

'Pfad für Verzeichnis festlegen
strPfad = "C:\Users\r.s\Baza\"

With Application
        .ScreenUpdating = False
        .EnableEvents = False
End With
 
'Alle Dateien aus Verzeichnis öffen,
DateiName = Dir(strPfad & "*.xlsx")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
         'wenn diese mit search100_Blumen_ beginnen
         If Left(DateiName, 18) = "search100_ Blumen_" Then
            Workbooks.Open Filename:=strPfad & DateiName
             'und erstes Blatt in diese Mappe kopieren
             Workbooks(DateiName).Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            'geöffnete Mappe wieder schließen, ohne speichern
            Workbooks(DateiName).Close SaveChanges:=False
         End If
        End If
        DateiName = Dir
    Loop

With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With

End Sub

Es wird immer das erste Blatt aus den Arbeitsmappen, die mit search100_ Blumen_ beginnen in die aktuelle Arbeitsmappe kopiert. Beachte bitte, dass es zu Fehlern kommen kann, wenn die zu kopierenden Tabellen gleiche Namen haben.

Gruß

M.O.

0 Punkte
Beantwortet von vbazh Einsteiger (24 Punkte)
Hallo M.O.

Das funktioniert leider nicht.

VBA Code zieht keine Tabelle mit.

NIcht mall die Erste.

Wo liegt das Fehler?

Dankeschön.
0 Punkte
Beantwortet von m-o Profi (12.2k Punkte)

Hallo,

kontrolliere bitte ob

  1. der Pfad stimmt und achte darauf, dass das letzte Zeichen ein \ ist
  2.  die Endungen der betreffenden Dateien richtig sind. Ich bin davon ausgegangen, dass diese mit .xlsx enden. Ändere mal die betreffende Zeile wie folgt:
    DateiName = Dir(strPfad & "*.xl*")
  3. die entsprechenden Dateien auch mit search100_ Blumen_ anfangen.

Gruß

M.O.

0 Punkte
Beantwortet von vbazh Einsteiger (24 Punkte)

Es gehet immer noch nicht. Tabellen Endungen sind "xls". Habe das in Code angepasst. Der Pfad habe ich kontroliert. Aber passiert wieder nichts.

das ist der Ordnername: C:\Users\r.s\Baza

und das ist Tabellenname: search100_ Blumen_Aarau_5002018-06-22-9-26-30

Alle fangen mit search100_  an.

Vielen Dank.

+1 Punkt
Beantwortet von m-o Profi (12.2k Punkte)

Hallo,

ich habe gerade gesehen, dass bei der Abfrage der Dateinamen ein Leerzeichen zu viel im Code ist sad.

Hier noch einmal der gesamte verbesserte Code:

Sub Dateien_oeffnen()
Dim DateiName As String
Dim strPfad As String

'Pfad für Verzeichnis festlegen
strPfad = "C:\Users\r.s\Baza\"

With Application
        .ScreenUpdating = False
        .EnableEvents = False
End With
 
'Alle Dateien aus Verzeichnis öffen,
DateiName = Dir(strPfad & "*.xl*")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
         'wenn diese mit search100_Blumen_ beginnen
         If Left(DateiName, 17) = "search100_Blumen_" Then
            Workbooks.Open Filename:=strPfad & DateiName
             'und erstes Blatt in diese Mappe kopieren
             Workbooks(DateiName).Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            'geöffnete Mappe wieder schließen, ohne speichern
            Workbooks(DateiName).Close SaveChanges:=False
         End If
        End If
        DateiName = Dir
    Loop

With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With

End Sub

Gruß

M.O.

+1 Punkt
Beantwortet von halfstone Profi (14.4k Punkte)

Hi,

Alle fangen mit search100_  an.

Da scheint mir noch eine Fehlerquelle zu sein.

Im Code wird nach dem Vorkommen von "If Left(DateiName, 18) = "search100_ Blumen_" Then" gesucht, also nach der Prefix "search100_ Blumen", laut dem Fragesteller ist aber nur das "search100_" immer gleich.

Gruß Fabian

+1 Punkt
Beantwortet von m-o Profi (12.2k Punkte)

Hallo,

ich der Eingangsfrage wurde geschrieben, dass diese mit search100_ Blumen_ anfangen. Auch bei meiner Nachfrage habe ich danach noch einmal gefragt. Und selbst wenn einige Dateien nicht mit das Wort "Blumen" im Dateinamen haben, hätte der Code wenigstens eine Datei öffnen müssen:

und das ist Tabellenname: search100_ Blumen_Aarau_5002018-06-22-9-26-30

Sollten natürlich auch Dateien geöffnet werden, die nur mit seach100_ anfangen, dann müsste der Code natürlich entsprechend geändert werden.

Gruß

M.O.

0 Punkte
Beantwortet von vbazh Einsteiger (24 Punkte)
Hallo Zusammen

Vielen Dank für Eure Hilfe. Der Code habe ich angepasst und er hatt jede einzelne Tabelle aufgemacht und alle in eine Tabelle aber dann in einzelnen Tabellenblätter aufgemacht. Jetzt soll ich entweder alle Tabellenbläter zusammen führen oder Code anpassen dass er die Daten sofort in ein Tabellenblat zusammen führt.

Habt Ihr ein Vorschlag?

Gruss
+1 Punkt
Beantwortet von m-o Profi (12.2k Punkte)

Hallo,

dann versuche es mal so:

Sub Dateien_oeffnen()
Dim DateiName As String
Dim strPfad As String

'Pfad für Verzeichnis festlegen
strPfad = "C:\Users\r.s\Baza\"

With Application
        .ScreenUpdating = False
        .EnableEvents = False
End With
 
'Alle Dateien aus Verzeichnis öffen,
DateiName = Dir(strPfad & "*.xl*")
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
         'wenn diese mit search100_Blumen_ beginnen
         If Left(DateiName, 17) = "search100_Blumen_" Then
            Workbooks.Open Filename:=strPfad & DateiName
             'und Inhalt des ersten Blatts in das erste Blatt der aktuellen Arbeitsmappe kopieren
             Workbooks(DateiName).Sheets(1).UsedRange.Copy ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
            'geöffnete Mappe wieder schließen, ohne speichern
            Workbooks(DateiName).Close SaveChanges:=False
         End If
        End If
        DateiName = Dir
    Loop

With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With

End Sub

Jetzt werden die Daten untereinander in das erste Blatt der Datei kopiert, in der der Code ist. Ich gehe davon aus, dass in der Spalte A der zu öffnenden Dateien Daten stehen.

Gruß

M.O.

0 Punkte
Beantwortet von vbazh Einsteiger (24 Punkte)
Hallo zusammen

Vielen, vielen Dank. Jetzt klappt es.

Beste Grüsse.
...