Clever-Excel-Forum

Hallo,

ich will mich kurz vorstellen. Ich heiße Frank und komme aus der Nähe von Wolfsburg. Eigentlich entwickle ich Software für Mikrocontroller. Coronabedingt muss ich nun auch im Officebereich mithelfen.

Ich habe folgendes Problem:

Ich bekomme eine große Anzahl von Excel-Dateien. Jede enthält eine Exceltabelle mit rund 30 Spalten. Diese Tabellen sind immer gleich. In den ersten 4 Spalten steht auch immer das gleiche drin. In den anderen Spalten ist pro Datei immer nur eine Spalte ausgefüllt. Ich muss nun diese Dateien zusammenführen und zwar so, dass am Ende eine Datei mit einer Tabelle rauskommt in der alle Spalten gefüllt sind. Also im Grunde so, als ob man alle Tabellen auf durchsichtigen Folien ausdruckt und dann übereinander legt.

Ich hoffe ich konnte das Verständlich ausdrücken. Ich habe nun schon den ganzen Tag versucht mit Makros, Youtube-Videos und PowerQuery mein Problem zu lösen, bekomme es aber einfach nicht hin.
Kann mir jemand sagen, wie ich das am besten umsetzen kann. Gerne auch mit einem Add-On o.ä. (Darf auch Geld kosten) Am liebsten wäre mir die Art leere Arbeitsmappe erstellen, alle Dateien die rein sollen auswählen und Makro o.ä. laufen lassen.

Wie gesagt, die Tabellen stimmen exakt überein, nur ist jeweils eine andere Spalte ausgefüllt.

Viele Grüße und vielen Dank
Frank

Hallo Frank,

da du Makros nicht ausschließt, könnte man da schon was entwickeln. Allerdings müsste man dann etwas mehr über die Dateien wissen. Am besten du stellst mal eine Beispieldatei mit wenigen anonymisierten Daten ein, damit man eine Vostellung bekommt.

Hallo,

meine Interpretation der Frage (ungeprüft)

Code:
'neues Workbook, xlsm, alle anderen xlsx

const Pfad as string = "c:\temp" '<<<<<<<< anpassen >>>>>>

sub Alle_zusammen

dim WB as Workbook

dim Bo as boolean

f = dir(Pfad & "*.xlsx")

do until f = vbnullstring

    set wb = workbooks.open(Pfad & f)

    if not bo then

        wb.sheets(1).usedrange.copy Range("A1")

        bo = true

    else

        cl = wb.sheets(1).cells(2, columns.count).end(xltoleft).column

        wb.sheets(1).columns(cl).copy cells(1, cl)        

    endif

    wb.close 0

f = dir

loop

set wb = nothing

end sub

Der Code kann Tippfehler enthalten.

mfg

Code:
Sub M_snb()

  c00 = "G:\OF\"

  c01 = Dir(c00 & "*.xlsx")

  Do Until c01 = ""

    With GetObject(c00 & c01)

      With .Sheets(1).UsedRange

        If ActiveSheet.UsedRange.Columns.Count < 4 Then ActiveSheet.Cells(1).Resize(.Rows.Count, 4) = .Resize(, 4).Value

        With .Offset(,4).SpecialCells(2)

          ActiveSheet.Cells(1, activesheet.usedrange.columns.Count + 1).resize(.count) = .Value

        End With

      end with

      .Close 0

    end with     

    c01 = Dir

  Loop

End Sub

Hallo Klaus-Dieter,

danke für die schnelle Rückmeldung. Ich habe mal eine Datei angehängt. In manchen Tabellen ist nur eine Spalte ausgefüllt, in anderen mehrere. Es gibt immer so viiele Dateien, dass alle Spalten ausgefültt sind.
Es kann aber auch sein, dass manche Zellen leer bleiben. Ich hoffe du kannst damit was anfangen.

Hallo Fennek, deinen Code habe ich übernommen und ausgeführt. Es passiert leider nichts. Keine Fehlermeldung, aber auch keine Daten in der neuen Tabelle.

Gruß Frank

Hallo,

nach der gzeigten Tabelle könnten die ersten DREI Spalten immer gleich sein und es könnte Dateien mit MEHR als einer ausgefüllte Spalte (hier E und O) geben.

Mein Code hat erwartet, dass die Tabelle in Zeile 1 beginnt, das ist aber leicht zu korrigieren.

mfg

Dann einfach so:

Code:
Sub M_snb()

  c00 = "G:\OF\"

  c01 = Dir(c00 & "*.xlsx")

  Do Until c01 = ""

      With GetObject(c00 & c01)

        With .Sheets(1).UsedRange

            If ActiveSheet.UsedRange.Columns.Count < 3 Then ActiveSheet.Cells(1).Resize(.Rows.Count, 3) = .Resize(, 3).Value

            For Each it In .Offset(, 4).SpecialCells(2)

              ActiveSheet.Cells(it.Row, it.Column) = it.Value

            End With

        End With

        .Close 0

      c01 = Dir

  Loop

End Sub

NB eine (intelligente) Datentabelle sollte anfangen in A1.

frank-wob

Klaus-Dieter

Fennek

snb

frank-wob

Fennek

snb