kompliziertes VBA - Hilfe erbeten -eilt
#1
Hallo liebe Forenmitglieder,

ich tüftle seit Tagen für meine Frau auf der Suche nach einer Lösung.

Es gibt in einem Verzeichnis etwa 50 Excel Dateien, jede Datei ist exakt gleich gegliedert. Im Tabellenblatt "Jahr" steht in der Spalte "L" untereinander für jeden Tag eines Monats eine Stundenangabe "Format 0,00". Genau stehen sie in L106 - L142, L155- L191, L204-L240 und in L253 - L289. 

Nun sollen alle Werte aller Dateien im Verzeichnis C:\Users\Dedl\Desktop\Test\ die in "Jahr" und "Spalte L" stehen (siehe vorstehend), in einer neuen Datei je in eine Zeile geschrieben werden und in der ersten Spalte "A" soll davor jeweils der Name der Quelldatei stehen.
Traumhaft, aber nicht zwingend erforderlich (könnte ich auch von Hand machen) wäre noch, wenn man einmalig in der ersten Zeile den Inhalt von der Spalte B als Überschrift einfügen könnte.

Ich habe zahllose VBA Scripts in Google gesucht und getestet, aber ich bekomme es nicht hin. Excel Version ist 2019 auf WINDOWS 10

Es wäre wirklich toll, wenn mir jemand von euch helfen könnte.

Ich sage schon mal herzlich Danke, wünsche schöne Feiertage und bitte, bleibt gesund

Detlef
Top
#2
Das geht gut mit Powerquery. Allerdings sind dazu Beispieldateien nötig.
Top
#3
Hier mal eine Muster-Quelldatei


Angehängte Dateien
.xlsx   Demo Mustermann.xlsx (Größe: 15,04 KB / Downloads: 9)
Top
#4
"[...]-Hilfe erbeten - eilt" ist kein besonders sympathischer Titel. Du wirst die Begründung dafür selbst finden.
WIN/MSO schicken angeblich alle 5 Sekunden Deinen Screen heim zu Papa (recall-Klausel). 
Top
#5
Hallo,

an diesen Kommentar schließe ich mich an und füge einen Code, der allerdings nur für die gezeigte Beispieldatei getestet ist, an.

Code:
Sub F_en()
Dim WB As Workbook
Dim WS As Worksheet: Set WS = ActiveSheet
Pfad = ThisWorkbook.Path & "\"
f = Dir(Pfad & "*.xlsx")
i = 1
Do While Len(f)
    
    Set WB = Workbooks.Open(Pfad & f)
    With WB.Sheets(1)
        WS.Cells(i, 1) = f
        For Each ar In .Columns(1).SpecialCells(2).Areas
            If ar.Columns.Count = 1 Then
                i = i + 1
                WS.Cells(i, 1) = f
                WS.Cells(i, 2) = i mod 12
                ar.Cells(4).Offset(, 11).Resize(31).Copy
                    WS.Cells(i, 3).PasteSpecial Transpose:=True
            End If
        Next ar
    End With
    WB.Close 0
    
f = Dir
Loop
End Sub

Viel Spaß beim Nachvollziehen.

mfg
Top
#6
Ich bin auch für Power Query.
https://excelhero.de/power-query/power-q...h-erklaert
[-] Folgende(r) 1 Nutzer sagt Danke an Cadmus für diesen Beitrag:
  • Frogger1986
Top
#7
Hier die Datei mit PowerQuery.
Top
#8
Da fällt mir eigentlich nur das ein: http://www.excel-ist-sexy.de/eilt-wichtig/
Schöne Grüße
Berni
Top
#9
Guten Morgen,

erst einmal DANKE an alle die sich dazu Gedanken gemacht haben, ich sehe ein, dass meine Überschrift unglücklich gewählt war. meine Frau ist im Pflegebereich und da liegen derzeit die nerven etwas blank was auch abfärbt, sorry!

Ich werde mal den Ansatz mit PowerQuery anschauen und experimentieren.

Sollte noch jemand einen anderen Gedankenansatz haben, so wäre ich dankbar dafür, leider kenne ich mit PowerQuery nicht gut aus und die Dankenswerterweise beigefügte Musterdatei verstehe ich (noch) nicht so ganz.

In diesem Sinne,

VG
detlef
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste