Excel Makro - Neue Tabelle erstellen und Inhalte aus 50 anderen Excel Tabellen importieren (Gleicher Aufbau)?

3 Antworten

Mal unabhängig von Makros: Falls Du Office 365 nutzt, könntest Du das auch mit Power BI sehr bequem machen und bist auch sehr flexibel, wenn es um Auswertungen geht.

Das Makro soll eine neue Excel Datei erstellen.

Ein Makro arbeitet jeweils den selben Vorgang ab.

Das Problem dabei ist, dass es nicht die selben Dateien sind deren Inhalt kopiert werden soll.

Allein der Name der Datei / Speicherort sind nicht identisch, auch der Zielort (Tabelle) unterscheidet sich.


TheDonk 
Beitragsersteller
 07.03.2023, 14:27

Das stimmt. Zurzeit bin ich irgendwie stecken geblieben und komme nicht weiter. Folgendes habe ich jetzt

Sub ImportZeilenAusDateien()
  Dim pfad As String
  Dim dateiname As String
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim Zeilenanzahl As Integer
   
  ' Ordnerpfad anpassen
  'Manuell
  'pfad = "C:\Users\(HIER NATÜRLICH DER RICHTIGE PFAD)"
  
   
  ' Überprüfen, ob der Ordnerpfad korrekt ist
  If Dir(pfad) = "" Then
    MsgBox "Der angegebene Ordnerpfad existiert nicht.", vbExclamation, "Fehler"
    Exit Sub
  End If
   
  ' Anzahl der zu importierenden Zeilen anpassen
  'Manuell
  'Zeilenanzahl = 15
   
   
  ' Neue Arbeitsmappe erstellen
  Set wb = Workbooks.Add
  Set ws = wb.Sheets(1)
   
  ' Schleife durch alle Excel-Dateien im Ordner
  dateiname = Dir(pfad & "*.xlsx")
  Do While dateiname <> ""
     
    ' Fehlermeldung hinzufügen, um den Dateinamen zu überprüfen
    MsgBox "Importiere Datei: " & dateiname
     
    ' Excel-Datei öffnen und Zeilen importieren
    Set wb2 = Workbooks.Open(pfad & dateiname)
    For i = 8 To Zeilenanzahl
      If IsEmpty(Cells(i, 1)) Then
        Exit For
      Else
         
        wb2.Sheets(1).Rows(i).Copy
        ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End If
    Next i
    wb2.Close False
     
    ' Nächste Datei im Ordner auswählen
    dateiname = Dir
  Loop
   
  ' Neue Arbeitsmappe speichern und schließen
  wb.SaveAs pfad & "Importierte Daten.xlsx"
  wb.Close
  MsgBox "Import abgeschlossen!", vbInformation, "Fertig"
   
End Sub

Das funktioniert soweit das die Daten aus den einzelnen Excel Tabellen in eine andere Excel Tabelle importiert werden (Das funktioniert auch) Nun muss ich irgendwie einfügen das der Name und Nachname vor jedem Gegenstand eingespeichert wird (Natürlich auch doppelt wenn mehrere verschiedene Gegenstände von der selben Person sind

Hallo,

ich habe auf Grund meiner Berufserfahrung Addins erstellt. Eines davon stellt den Inhalt aller Excelmappen ganz einfach untereinander.

I Ich nehme an, Du meinst nicht 50 Dateien, sondern 50 Arbeitsblätter. Sofern diese jeweils in einer eigenen Datei abgespeichert sind, müssen diese in eine neue Datei verschoben werden, sodass alle Blätter in dieser einen Arbeitsmappe stehen.

Das Tool erstellt eine Liste mit allen Namen der Blätter in der offenen Arbeitsmappe. Diese Liste wird im linken Teil einer Dialogbox angezeigt, die nach dem Start des Tools und Eingabe der Grunddaten vom Tool auf dem Bildschirm angezeigt wird. Daraus werden die Blattnamen angeklickt, deren Blätter zusammenzuführen sind. Die markierten Blattnamen werden in die rechte Box geschoben. Nach Klick auf ok werden die Blattinhalte der Blätter aus der Box "zusammengeführte Blätter", egal wieviel Zeilen jedes einzelne Blatt hat, untereinander gesetzt.

Bild zum Beitrag

Ist damit Dein Problem gelöst? Das neue Blatt kann dann ggf. mit meinem Tool "geschachteltes Teilergebnis" oder Pivot ganz einfach verdichtet werden.

LG

Siegfried

Woher ich das weiß:Berufserfahrung
 - (programmieren, Microsoft Excel, VBA)