maxueli
Goto Top

Von mehreren Arbeitsmappen, einen Datenbereich anstelle von Formeln die Werte per VBA in eine andere Arbeitsmappe zusammenführen.

Ich bin mir ziemlich sicher, dass wenn man sucht, jemand eine Lösung findet. Nun habe ich eine Excel Aufgabe erhalten, die ich leider nicht alleine lösen kann. Mit VBA und Makros habe ich keine Erfahrung. Wäre schön wenn mir jemand aus diesem Forum helfen könnte. Ich habe hier schon einige fast Lösungen entdeckt, aber es geht dann leider doch immer noch daneben.
Gruss maxueli

Hier meine Aufgabe:
In mehreren Ordner in der Windows Verzeichnisstruktur sind etliche Excel Arbeitsmappen mit der Bezeichnung „Personennamen.xls (Pro Mitarbeiter eine Datei) enthalten.
Diese Dateien sind für die Mitarbeiter erstellt, damit die Stundenaufwendungen eingetragen werden können. Die Stunden vom Januar trägt er in die Tabelle „Monat_Januar“ ein. Somit sind in der obigen Datei immer 12 Tabellen enthalten.
Monatlich möchte ich nun aus den etlichen „Personennamen.xls“ mit einem Makro eine Arbeitsmappe „Stundenzusammenfassung.xls“ für die Auswertung erstellen. Diese Mappe hat eine Tabelle „Daten-Import“.
Die Daten Ergebnisse in den „Persoanlnamen.xls“ werden mehrheitlich aus Formeln zusammengestellt.
Das Makro sollte sich in der Arbeitsmappe „Stundenzusammenfassung.xls) befinden.
Bei der Ausführung holt das Makro in den div. „Personalnamen.xls“ in der Tabelle „Stunden_Januar“ ab Zelle A6 bis Spalte F(Zeilenanzahl nach unten in der Tabelle ist variabel) die Daten und kopiert die Daten als „Werte“ in die Tabelle „Daten-Import“ untereinander in der Arbeitsmappe „Stundenzusammenfassung.xls . Dazwischen sollten wenn möglich die Daten vom nächsten Mitarbeiter eingefügt werden eine Leerzeile eingefügt werden.
Es sollen nicht die Formeln kopiert werden, sondern nur die Werte.
Wenn das Makro im nächsten Monat erneut ausgeführt wird, sollen die Daten vom Tabelle „ Stunden_Februar“ geholt werden. Die alten Werte in der Tabelle „Daten-Import“ vom Januar sollen ab Zeile 7 alle gelöscht werden, wenn die Werte vom Februar geholt werden.
Die ersten 6 Zeilen in der Tabelle „Daten-Import“ sollen durch das Makro nicht bearbeitet werden, weil Kommentare und Text in diesem Bereich steht.
Ich hoffe, dass ich meine Aufgabe für das Forum nachvollziehbar formuliert habe.

Content-Key: 138203

Url: https://administrator.de/contentid/138203

Ausgedruckt am: 29.03.2024 um 13:03 Uhr

Mitglied: StefanKittel
StefanKittel 15.03.2010 um 00:14:19 Uhr
Goto Top
Zitat von @maxueli:
Es sollen nicht die Formeln kopiert werden, sondern nur die Werte.
cells(0,0).value liefert den Wert

Stefan
Mitglied: Biber
Biber 15.03.2010 um 00:38:17 Uhr
Goto Top
^Moin maxueli,

willkommen im Forum.

Rückfragen:
  • wo tauchen in der "monatlichen Zusammenfassung" die identifizierenden Daten der Mitarbeiter auf (Name oder PersNr)? Sollen die aus dem Quell-XLS-Dateinamen übernommen werden?
  • Wenn denn schon eine "monatliche Zusammenfassung", warum dann nicht je eine für "Zusammenfassung_2010-01.xls" etc?
  • wenn denn schon eine weitere Kopie bereits vorhandener Daten meinetwegen mit dem Etikett "Zusammenfassung" - warum wird da nichts zusammengefasst, sondern alle Details in epischer Länge übernommen?

Grüße
Biber
Mitglied: 76109
76109 15.03.2010 um 01:59:55 Uhr
Goto Top
Hallo maxueli!

Also, von mir erstmal ein großes Lob für gute Beschreibung Deines Vorhabensface-wink

Der nachfolgende Code durchsucht in dem angebebenen Ordnerpfad (ExternPfad) alle Unter-Ordner der 1. Ebene nach *.xls-Dateien. Für den entsprechenden Monat habe ich zunächst einmal eine InputBox mit der Abfrage des Monats als Zahl vorgesehen. Das automatische ermitteln des aktuellen Monats anhand des Datums wäre hierbei auch eine Möglichkeit. Ansonsten denke ich, dass ich alle Deine Kriterien soweit berücksichtigt habe.

Quellcode in ein Modul kopieren und die Konstanten entsprechend anpassen:
Option Explicit
Option Compare Text

Const ExternPfad = "E:\Threads\$Test\TestToDo"      'Externe Dateien Ordner-Pfad  
Const ExternRange = "A6:F"                          'Externe Dateien Zell-Teilbereich  

Const InternSheet = "Daten-Import"                  'Interne Tabelle für den Import  

Const InternStart = 7                               'Interne Tabelle Start-Zeile  

Const Msg1 = "Bitte Monatszahl (1-12) eingeben:"  
Const Err1 = "Der angegebene Ordner existiert nicht!"  
Const Err2 = "Die Eingabe ist ungültig!"  

Sub GetExternData()
    Dim Wks As Worksheet, Wks0 As Worksheet, WkbX As Workbook, WksX As Worksheet, SheetName As String
    Dim Fso As Object, Folder As Object, File As Object, Monat As Integer, NextLine As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    If Fso.FolderExists(ExternPfad) = False Then MsgBox Err1, vbExclamation, "Fehler":  Exit Sub  
    
    Monat = Application.InputBox(Msg1, "Eingabe Monat", "1", Type:=1)  
    
    If Monat <= 0 Then Exit Sub
    
    If Monat > 12 Then MsgBox Err2, vbExclamation, "Fehler": Exit Sub  
    
    SheetName = "*" & GetMonth(Monat) & "*"  
    
    Set Wks0 = ThisWorkbook.Sheets(InternSheet)
    
    Wks0.Range(Rows(InternStart), Rows(Wks0.Rows.Count)).Cells.ClearContents
    
    NextLine = InternStart
    
    Application.ScreenUpdating = False
    
    For Each Folder In Fso.GetFolder(ExternPfad).SubFolders
        For Each File In Folder.Files
            If Fso.GetExtensionName(File) Like "XLS" Then  
                Set WksX = Nothing
                Set WkbX = GetObject(File.Path)
                
                For Each Wks In WkbX.Worksheets
                    If Wks.Name Like SheetName Then Set WksX = Wks:  Exit For
                Next
                                
                If Not WksX Is Nothing Then
                    WksX.Range(ExternRange & GetEndLine(WksX)).Copy
                    Wks0.Cells(NextLine, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats  
                    
                    With Application
                        .DisplayAlerts = False:  WkbX.Close False:  .DisplayAlerts = True
                    End With
                    
                    NextLine = GetEndLine(Wks0) + 2
                End If
            End If
        Next
    Next
    
    Wks0.Cells(InternStart, "A").Select  
    Application.ScreenUpdating = True
End Sub

Private Function GetEndLine(ByRef Wks) As Long
    GetEndLine = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row  
End Function

Private Function GetMonth(ByVal M As Integer) As String
    GetMonth = Switch(M = 1, "_Jan", M = 2, "_Feb", M = 3, "_Mär", M = 4, "_Apr", _  
                      M = 5, "_Mai", M = 6, "_Jun", M = 7, "_Jul", M = 8, "_Aug", _  
                      M = 9, "_Sep", M = 10, "_Okt", M = 11, "_Nov", M = 12, "_Dez")  
End Function

Gruß Dieter
Mitglied: maxueli
maxueli 15.03.2010 um 19:35:03 Uhr
Goto Top
Hallo Dieter
Da bin ich mal wieder! Vorerst vielen Dank für Deine prompte Hilfe.

Dein Vorschlag für den Ablauf finde ich sehr gut, den Pfad habe ich geändert, das Makro findet die Dateien, obwohl diese als Test in zwei Ordner gespeichert sind. Wenn das Projekt mal läuft sind die Arbeitsmappen in diversen Ordner abgelegt.

Das Makro macht einen Fehler = Dialog Laufzeitfehler `1004` Anwendungs-oder objektdef………Fehler
Zeile Nr. 68 GetEndLine = Wks.Cells(Rows.Count, "A").End(xlUp).Row

Weiteres Problem:
1. Die Arbeitsmappen „Personennamen.xls“ dürfen nur gelesen werden und sind sofort automatisch wieder zu schliessen. Das Makro löscht jetzt die ausgelesene Tabelle „Monat_Januar“ , dass soll nicht sein. Wenn ich als Test die Arbeitsmappe „Personennamen.xls“ Speichern ja drücke , weil ich dazu aufgefordert wurde, dann ist nachher die Tabelle „Monat_Januar“ und auch Monat_Februar nicht mehr vorhanden.

2. In der Arbeitsmappe „Stundenzusammenfassung.xls“ wird in der Tabelle „Daten-Import“ leider gar nichts eingetragen. Wenn in der Tabelle „Daten-Import“ aber Testwerte schon vorhanden sind werden diese inkl. Zeile 7 und folgende gelöscht, dass ist gut.

Im weiteren befürchte, dass nur eine Mappe „Persnonennamen.xls“ abgefragt wird, dass lässt sich aber momentan nur schwer feststellen.
So, dass währe im Moment alles, was ich festgestellt habe, kannst Du Dich nochmal reindenken?
Grüesse freundlich
Max
Mitglied: 76109
76109 15.03.2010 um 19:53:54 Uhr
Goto Top
Hallo Max!

Die Codezeile 68 habe ich geändert und sollte jetzt gehen. Wenn dieser Teil nicht Funktioniert, dann geht natürlich der ganze Rest nicht, da diese Funktion immer die letzte Zeile eines Bereichs ermittelt.

Das mit der Speichernabfrage kann ich mir allerdings nicht erklären, da ich in der Codezeile 54, diese Abfrage eigentlich unterbinde und die jeweilige Personennamen.Xls ohne Änderung schließe. Das ist jedenfalls der Sinn dieser Codezeile und funktioniert in der Regel?

Gruß Dieter

PS. Letzterer Fehler hängt mit der GetEndLine-Funktion zusammen, weil Du einen Laufzeitfehler erhalten hast, wurde der Rest des Codes nicht ausgeführt und somit hast Du die Auffordung erhalten "Personennamen.Xls zu speichern". Also falls es nochmal zu einem Laufzeitfehler kommen sollte, dann das Speichern in jedem Fall VERNEINEN.
Mitglied: maxueli
maxueli 15.03.2010 um 21:53:12 Uhr
Goto Top
Hoi Dieter
Kann Dir nur noch viel…..vielmals Danke mailen, das Makro funktioniert einwandfrei, klar und übersichtlich für mich. Jetzt mache ich noch das Fine Tuning an den Arbeitsmappen und dann fertig, was will man mehr. Auch einen Dank an Alle die mir ebenfalls geantwortet haben, die Lösung von Dieter hat mir einfach am besten gefallen.
Gruss Max
Mitglied: 76109
76109 15.03.2010 um 22:06:07 Uhr
Goto Top
Hallo Max!

Yepp, gern geschehenface-wink

Freut mich, wenn es nun wie vorgesehen funktioniert.

Gruß Dieter

PS. Habe in der Codezeile 33 sicherheitshalber auch noch eine kleine Änderung vorgenommen.
Mitglied: maxueli
maxueli 16.03.2010 um 23:37:13 Uhr
Goto Top
Hey Dieter
Hab nun bereits das ganze Projekt verfeinert. Da sind noch zwei Hinweise gekommen.
1. Aus den Arbeitsmappen „Personennamen.xls“ möchte ich nun noch explizit einzelne durch den Makro-Code zu definierende Spalten, z.B. Spalte A-F und Spalte H, usw. in die Arbeitsmappe „Stundenzusammenfassung.xls“ Tabelle „Daten-Import“ übernehmen können. Wie vorher ist die Zeilenanzahl variabel. Ich kann auch ein Makro über den Recorder erstellen für dieses Bedürfnis. Aber ev. hast Du eine Lösung in Deinem Körbchen.
2. Wie wird sichergestellt, dass wenn ein Mitarbeiter in seinem Blatt den Spezial-Filter verwendet, trotzdem alle Zeilen aus dem „Personennamen.xls“ geholt werden.
Das Makro sollte prüfen ob in bestimmten Zeilen ein Wert steht, z.B alle Zeilen in Spalte H welche einen Wert haben, müssen gelesen werden.
Es währe blöde wenn deshalb nicht alle Zeilen im Stundenzusammenfassung.xls erscheinen. Es kann natürlich auch geschult werden.
JA, nun müsste ich Dich eigentlich noch einmal bitten, ob Du die Sache anschauen kannst. Besten Dank.
Schönen Gruss aus der Schweiz von Max
Mitglied: 76109
76109 17.03.2010 um 10:35:28 Uhr
Goto Top
Hallo Max!

Oha, habe heute tagsüber leider wenig Zeit und werde mir das erst heute Abend etwas genauer ansehen könnenface-wink

Grüße aus Deutschland

Dieter
Mitglied: 76109
76109 17.03.2010 um 18:44:40 Uhr
Goto Top
Hallo Max!

Zitat von @maxueli:
1. Aus den Arbeitsmappen „Personennamen.xls“ möchte ich nun noch explizit einzelne durch den Makro-Code zu
definierende Spalten, z.B. Spalte A-F und Spalte H, usw. in die Arbeitsmappe „Stundenzusammenfassung.xls“ Tabelle
„Daten-Import“ übernehmen können. Wie vorher ist die Zeilenanzahl variabel. Ich kann auch ein Makro...
Wäre zunächst meine 1. Frage, wie kopiert werden soll? 1:1 oder z.B. Spalte A-F und Spalte H in Ziel in Spalte A-G?

Gruß Dieter
Mitglied: maxueli
maxueli 17.03.2010 um 23:45:42 Uhr
Goto Top
Hallo dieter

Also es geht darum , dass ich in in der Stundezusammenfassung nicht alle Spaltenwerte von den Personennamen xls benötige, z.B. brauche ich die Werte aus der Spalte B nicht.
Jetzt habe ich mir gedacht, dass Du im Makro bereiche definierst, welche kopiert werden.
Bisher war es ja A6:J, nun wäre es neu A6:B, und D6:F und noch die Spalten werte ab H6:H,
würde das gehen? Wenn der Code vorliegt kann ich ja selber den Bereich noch anpassen.
Das ist dann leicht für mich zu machen.
Besten Dank und schönen Abend.
Gruss Max
Mitglied: 76109
76109 17.03.2010 um 23:52:40 Uhr
Goto Top
Hallo nochmal!

Zu 2. Der SpecialFilter ist etwas problematisch?

AutoFilter wäre kein Problem, aber bei SpecialFilter finde ich keine Möglichkeit, per VBA Informationen abzufragen. Das wäre aber soweit kein Problem, denn dafür hätte ich trotzdem eine Lösung. Wenn allerdings im SpecialFilter die Funktion Kopieren ausgewählt wird/wurde und sich die Filter-Daten irgendwie im Bereich der zu kopierenden Daten befinden, sehe ich keine Möglichkeit herauszufinden, was jetzt Kopierdaten und/oder was jetzt Filterdaten sind.

Ein weiteres unlösbares Problem wäre noch, wenn Filter gesetzt sind und die Arbeitsmappen und/oder Tabellenblätter geschützt sind. Dann besteht überhaupt keine Möglichkeit die Daten vollständig zu kopieren.

D.h. von der Funktion her, müsste man das jeweilige Tabellenblatt temporär kopieren, die Filter außerkraftsetzen und dann erst kopieren, aber das geht eben nur ohne Schutz.

Gruß Dieter

PS. Es sei denn, Du hättest die Passwörter, dann wäre ein eventueller Schutz auch kein Problem
Mitglied: 76109
76109 18.03.2010 um 00:02:48 Uhr
Goto Top
Hallo Max!

Zitat von @maxueli:
Also es geht darum , dass ich in in der Stundezusammenfassung nicht alle Spaltenwerte von den Personennamen xls benötige,
z.B. brauche ich die Werte aus der Spalte B nicht.
Jetzt habe ich mir gedacht, dass Du im Makro bereiche definierst, welche kopiert werden.
Bisher war es ja A6:J, nun wäre es neu A6:B, und D6:F und noch die Spalten werte ab H6:H,
würde das gehen? Wenn der Code vorliegt kann ich ja selber den Bereich noch anpassen.
Das ist dann leicht für mich zu machen.
Ja, dass ist soweit schon klar und auch kein Problem, sofern wie gesagt, die Daten aber dann in der Zusammenfassung wieder zusammenhängend kopiert werden. Z.B. Spalten A:B und Spalten E:F und Spalte H würde dann in der Zusammenfassung als Spalte A:E eingefügt werden, also hintereinanderface-wink

Gruß Dieter
Mitglied: maxueli
maxueli 18.03.2010 um 00:10:24 Uhr
Goto Top
Oh Entschuldigung, Autofilter ist richtig, nicht Spezialfilter.

Die Arbeitgsmappen „Personennamen.xls“ sind mit Blattschutz versehen und die Zellen sind geschützt, weil die dort vornenden Formeln durch den Mitarbieter nicht nicht verändert werden dürfen, der Mitarbeiter kann nur auf wenige Zellen zugreifen, es gibt für ihn erlaubte Eingabefelder in der "Personenamen xls", natürlich kann er auch den Autofilter benutzen. Eine Spalte ist mit Autofilter belegt, dort kann er bei seinen Aufträgen eine 1 oder X schreiben, damit er die Uebersicht für sein Auftträge Filtern kann.
Wie gesagt dass ist alles auch ein wenig "nice to have" aber wenn es gehen würde wäre es natürlich super.

Bis bald Gruss Max
Mitglied: maxueli
maxueli 18.03.2010 um 00:19:15 Uhr
Goto Top
Hier noch die Info zum Passwort.
Das Passwort für den Arbeitsmappenschutz verwalte ich, und ist für alle Tabellen gleich, z.B "herbst". Der MA hat nichts damit zu tun. Das Passwort kann nur ich änderen. Könnte aber so im Makro stehen, dass Du über Makro in alle Tabellen reingreifen kannst.
Bis bald Gruss Max
Mitglied: 76109
76109 18.03.2010 um 00:22:24 Uhr
Goto Top
Hallo Max!

OK, es gibt die die Möglichkeit trotz Blattschutz Filter zu verwenden, wenn diese Funktionen freigegeben wird. Und ist die Arbeitsmappe auch mit einem Schutz versehn oder nur die Tabellenblätter. Ein Tabellenblatt kann nähmlich nur kopiert werden, wenn der Arbeitsmappen-Schutz aufgehoben ist (das ganze Tabellenblatt ist gemeint)?

Gruß Dieter

PS Oder besser wäre es natürlich, wenn man den Filter zum Kopieren einfach außerkraftsetzen könnte, ohne ihn wiederherstellen zu müssen
Mitglied: maxueli
maxueli 18.03.2010 um 00:32:41 Uhr
Goto Top
zum einfügen.
Ja, dass ist soweit schon klar und auch kein Problem, sofern wie gesagt, die Daten aber dann in der Zusammenfassung wieder zusammenhängend kopiert werden. Z.B. Spalten A:B und Spalten E:F und Spalte H würde dann in der Zusammenfassung als Spalte A:E eingefügt werden, also hintereinander.

Hinereinader verstehe ich so, dass aus den kopierten Bereichen beim einfügen wieder ein Bereich entsteht, und darin die Zeilenwerte, wieder als Zeilen zusammengesetzt sind, es werden also einfach nicht alle Zellen aus den vorhandenen Spalten kopiert. Die quasi neu zusammengestzte Zeile im „Stundenzusammenfassung.xls“ Tabelle
„Daten-Import“ ist aber klar die Auswertung der Zeile „Personennamen.xls“
Freundliche Grüsse Max
Mitglied: maxueli
maxueli 18.03.2010 um 00:46:41 Uhr
Goto Top
Hallo Dirk
Jetz hoffe ich alle Infos zugestellt zu haben. Die Arbeitsmappen „Personennamen.xls“ kann ich so gestalten, dass ich jede der 12 Tabellen Einzel mit dem Blattschutz belege immer das gleiche Passwort "herbst". Die Auswertung "Stundenzusammenfassung.xls“ läuft nur einmal im Monat, immer ca. im 2. od. 3. Tag im nächsten Monat, da könnte der Filter für den Monat 1 zurückgenommen werden.
Nach der Auswertung sollte der Blattschutz wieder mit dem Makro aktiviert werden. Der Autofilter ist für den Monat 1 nicht mehr erforderlich.
Wie ist Deine Meinung für die Gestaltung der „Personennamen.xls“ kann ich so weitermachen?

Gruss Max
Mitglied: 76109
76109 18.03.2010 um 08:40:40 Uhr
Goto Top
Guten Morgen Max!

Zitat von @maxueli:
Hallo Dirk
War wohl doch schon etwas spät am Abendface-wink
"Stundenzusammenfassung.xls“ läuft nur einmal im Monat, immer ca. im 2. od. 3. Tag im nächsten Monat, da
könnte der Filter für den Monat 1 zurückgenommen werden.
Sorry, bei mir war's wohl auch schon zu spät und hatte irgendwie vor lauter Schutz vergessen, dass die Personennamen.xls ja ohne speichern geschlossen wird. Von daher ist es vollkommen wurscht, ob der Filter einfach gelöscht wird. Da habe ich doch tatsächlich Dich und mich selber verwirrt und habe für meine Doofheit eigentlich Haue verdientface-wink
Nach der Auswertung sollte der Blattschutz wieder mit dem Makro aktiviert werden...
An den Personennamen.xls ändert sich nichts.
Wie ist Deine Meinung für die Gestaltung der „Personennamen.xls“ kann ich so weitermachen?
Ist soweit alles realisierbar.

Zum Thema Schutz und AutoFilter:
Das hat sich eigentlich auch soweit erledigt, sofern sich der Autofilter auch ohne Schutz deaktivieren läßt.

Zum Thema Kopieren der Zellinhalte:
Wenn ich Dich weiter oben richtig verstanden habe, dann soll im Tabellenblatt Personennamen.xls aktuell die Spalte H als Bezugspunkt für die Kopieraktion verwendet werden. D.h. in Spalte H die letzte Zeile mit Inhalt ermitteln und außerdem nur Zeilen kopieren, in denen die Zelle in Spalte H nicht Leer ist. Wenn dem so ist, wäre es für mich dann noch interessant zu wissen, ob in diesem Fall dann auch die Spalte A einen Wert enthält, also Zelle H und Zelle A sind nicht Leer?

Diese Angabe ist insofern wichtig, um in der Zusammenfassung die letzte Zeile (NextLine) ermitteln zu können. Die Spalte H ist ja nach dem Kopiervorgang nicht mehr Spalte H sondern im Beispiel Kopie Spalten A:B und D:F und H dann die Spalte F. Von daher wäre es gut einen festen Bezugspunkt wie z.B. Spalte A verwenden zu können.

Gruß Dieter
Mitglied: 76109
76109 18.03.2010 um 10:24:38 Uhr
Goto Top
Hallo Max!

Hier mal ein neuer Code. In der Annahme, dass ich soweit alles richtig verstanden habe.

Geändert hat sich im wesentlichen:
1. Die Konstanten in Bezug auf Extern..
2. Die Funktion GetEndLine mit Spaltenangabe
3. Löschen des AutoFilters
4. Der Kopierteil mit Test auf Leer-Zelle und Zeilenweise kopieren

Option Explicit
Option Compare Text

Const ExternPfad = "E:\Threads\138203\ToDoListen"   'Externe Dateien Ordner-Pfad  
Const ExternRange = "A?:B?,D?:F?,H?"                'Externe Dateien Zellbereich (?=Per Code Zeilennummer einfügen)  
Const ExternStart = 6                               'Externe Dateien Startzeile  
Const ExternSpalte = "H"                            'Externe Dateien Bezugsspalte (Leer-Test)  

Const InternSheet = "Daten-Import"                  'Interne Tabelle für Import  
Const InternStart = 7                               'Interne Tabelle Startzeile  

Const Msg1 = "Bitte Monatszahl (1-12) eingeben:"  
Const Err1 = "Der angegebene Ordner existiert nicht!"  
Const Err2 = "Die Eingabe ist ungültig!"  

Sub GetExternData()
    Dim Wks As Worksheet, Wks0 As Worksheet, WkbX As Workbook, WksX As Worksheet, SheetName As String
    Dim Fso As Object, Folder As Object, File As Object, Monat As Integer, NextLine As Long, c As Range
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    If Fso.FolderExists(ExternPfad) = False Then MsgBox Err1, vbExclamation, "Fehler":  Exit Sub  
    
    Monat = Application.InputBox(Msg1, "Eingabe Monat", "1", Type:=1)  
    
    If Monat <= 0 Then Exit Sub
    
    If Monat > 12 Then MsgBox Err2, vbExclamation, "Fehler": Exit Sub  
    
    SheetName = "*" & GetMonth(Monat) & "*"  
    
    Set Wks0 = ThisWorkbook.Sheets(InternSheet)
    
    Wks0.Range(Rows(InternStart), Rows(Wks0.Rows.Count)).Cells.ClearContents
    
    NextLine = InternStart
    
    Application.ScreenUpdating = False
    
    For Each Folder In Fso.GetFolder(ExternPfad).SubFolders
        For Each File In Folder.Files
            If Fso.GetExtensionName(File) Like "XLS" Then  
                Set WksX = Nothing
                Set WkbX = GetObject(File.Path)
                
                For Each Wks In WkbX.Worksheets
                    If Wks.Name Like SheetName Then Set WksX = Wks:  Exit For
                Next
                                
                If Not WksX Is Nothing Then
                    
                    WksX.AutoFilterMode = False
                    
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalte))  
                        If Not IsEmpty(c.Columns(ExternSpalte)) Then
                            WksX.Range(Replace(ExternRange, "?", c.Row)).Copy  
                            Wks0.Cells(NextLine, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats  
                            NextLine = NextLine + 1
                        End If
                    
                    Next
                    
                    With Application
                        .DisplayAlerts = False:  WkbX.Close False:  .DisplayAlerts = True
                    End With
                    
                    NextLine = GetEndLine(Wks0, "A") + 2  
                End If
            End If
        Next
    Next
    
    Wks0.Cells(InternStart, "A").Select  
    Application.ScreenUpdating = True
End Sub

Private Function GetEndLine(ByRef Wks, ByVal Col As Variant) As Long
    GetEndLine = Wks.Cells(Wks.Rows.Count, Col).End(xlUp).Row
End Function

Private Function GetMonth(ByVal M As Integer) As String
    GetMonth = Switch(M = 1, "_Jan", M = 2, "_Feb", M = 3, "_Mär", M = 4, "_Apr", _  
                      M = 5, "_Mai", M = 6, "_Jun", M = 7, "_Jul", M = 8, "_Aug", _  
                      M = 9, "_Sep", M = 10, "_Okt", M = 11, "_Nov", M = 12, "_Dez")  
End Function

Auch in der Annahme, das sich der AutoFilter hinsichtlich des Blattschutzes ohne Schutzaufhebung deaktivieren läßt?

Gruß Dieter
Mitglied: maxueli
maxueli 18.03.2010 um 11:58:08 Uhr
Goto Top
Hallo Dieter

Du hast es richtig verstanden, wenn in Spalte H, im def. Bereich ein Wert in einer Zelle vorhanden ist, dann soll die ganze Zeile kopiert werden, jedoch soll der Wert in der Spalte C auf der gleichen Zeile nicht im Zusammenzug erscheinen.
In der Spalte A und B steht in jeder Zelle immer ein Wert drin. Wenn in der Spalte H nach unten kein Wert mehr folgt, dann ist das Ende erreicht.

Ds Makro will noch nicht.
1.Mir ist nicht klar, was ich in den Code schreiben soll:
Const ExternRange = "A?:B?,D?:F?,H?" 'Externe Dateien Zellbereich (?=Per Code Zeilennummer einfügen)
ich habe u.a.folgendes probiert: geht aber nicht.
Const ExternRange = "A100:B100,D100:F100,H100" 'Externe Dateien Zellbereich (?=Per Code Zeilennummer einfügen)

Es gibt einen Laufzeitfehler "9"
aus Code zeile 32
Set Wks0 = ThisWorkbook.Sheets(InternSheet)
Kannst Du nochmal testen.
Gruss Max
Mitglied: 76109
76109 18.03.2010 um 12:25:15 Uhr
Goto Top
Hallo Max!

Zitat von @maxueli:
Ds Makro will noch nicht.
1.Mir ist nicht klar, was ich in den Code schreiben soll:
Const ExternRange = "A?:B?,D?:F?,H?" 'Externe Dateien Zellbereich (?=Per Code Zeilennummer
einfügen)
ich habe u.a.folgendes probiert: geht aber nicht.
Const ExternRange = "A100:B100,D100:F100,H100" 'Externe Dateien Zellbereich (?=Per Code Zeilennummer einfügen)
Das hast Du missverstanden. Habe extra in Klammer geschrieben "?=Per Code..."face-wink

Die Fragezeichen sind Dummys für die Zeilennummer, die ja noch unbekannt sind und erst in der Kopier-Routine initialisiert bzw. durch die jeweilige Zeilennumer ersetzt werden (Siehe Codezeile 56 Replace). Also, bei Range-Angabe die Zeilennumer immer als Fragezeichen angeben. Indem Fall stimmen ja die Vorgaben bereits und muss nix geändert werden.

Gruß Dieter
Mitglied: maxueli
maxueli 18.03.2010 um 12:56:53 Uhr
Goto Top
Hoi Dieter
habs wieder geändert, kriege aber trotzdem den Laufzeitfehler "9"
Zeile 32: Set Wks0 = ThisWorkbook.Sheets(InternSheet)
wo kanns denn jetzt noch fehlen?

Gruss Max
Mitglied: 76109
76109 18.03.2010 um 13:05:02 Uhr
Goto Top
Hallo Max!

Dann hast Du eventuell was verändert und das Tabellenblatt "Daten-Import" existiert nicht bzw. die Konstante "InternSheet" nicht entsprechend angepasst?

Gruß Dieter
Mitglied: maxueli
maxueli 18.03.2010 um 13:33:34 Uhr
Goto Top
Hallo Dieter

Fehler: "Daten_Import", statt "Daten-Import"
Ich denke, jetzt habe ich es so wie gewollt. Die Ausgestaltung der Blätter kann ich nun selber machen.

Jetzt läuft es Super, Extrakt ist nun übersichtlich, ich bin begeistert wie Du mir so rasch geholfen hast.
Die Ausgestaltung der Blätter kann ich nun selber machen. Projekt schliessen wir nun ab.

Gerne würde ich Dir als süssen Dank eine CH-Praline zukommen lassen.
Kannst mir wenn Du willst die Adresse auf mein
Gruss und Tschüss auf ein andermal.
Max
Mitglied: 76109
76109 18.03.2010 um 13:42:16 Uhr
Goto Top
Hallo Max!

Zitat von @maxueli:
Fehler: "Daten_Import", statt "Daten-Import"
Sowas in der Art hatte ich vermutetface-wink
Jetzt läuft es Super, Extrakt ist nun übersichtlich, ich bin begeistert wie Du mir so rasch geholfen hast.
Die Ausgestaltung der Blätter kann ich nun selber machen. Projekt schliessen wir nun ab.
Prima, freut mich, wenn soweit alles rundläuft!
Gerne würde ich Dir als süssen Dank eine CH-Praline zukommen lassen.
Kannst mir wenn Du willst die Adresse auf mein E-Mail ......................... zustellen.
Danke, auf das Angebot komme ich gerne zurückface-smile Aber die EMail-Adresse solltest Du schnell wieder entfernen (Spams...)!

Gruß Dieter
Mitglied: maxueli
maxueli 18.03.2010 um 14:26:54 Uhr
Goto Top
Hallo Dieter

ich habe die E-Mail in meinem Beitrag gelöscht, in Deinen letzten Beitrag ist diese noch vorhanden, bitte bearbeite Deinen Beitrag damit die E-Mail verschwindet.
Besten Dank
Gruss Max
Mitglied: 76109
76109 18.03.2010 um 14:37:40 Uhr
Goto Top
Hallo Max!

Ups, da habe ich wohl auch wieder etwas geschlafenface-wink

Gruß Dieter
Mitglied: maxueli
maxueli 22.03.2010 um 18:07:45 Uhr
Goto Top
Hallo Dieter
Hast Du das schöne Wochenende genossen, (Frühlingsanfang u.so.)?
In der Zwischenzeit habe ich den Ablauf verfeinert, dabei bin ich noch auf ein kleines Problem gestossen.
Wenn im „Persnonennamen.xls“ Tabelle „_Jan“ in der Spalte J in Zellen Formeln drin sind, deren Wert 0 ergibt, dann sollten die entsprechenden Zeilen auch nicht übergeben werden. Es müsste als ähnlich behandelt werden, wie die Spalte H, wo wenn die Zelle kein Text enthält, die ganze Zeile nicht auf den „Stundenzusammenfassung.xls“ übergeben wird. Das hast du im Makro bereits abgefangen.
Kannst Du das noch machen, wenn nicht kann ich auf der Arbeitsmappe „Stundenzusammenfassung.xls“ über sortieren und anschliessend Zeilen löschen auch zum Ziel kommen. Es wäre einfach noch eleganter, wenn die Daten schon über das Makro gefiltert werden.
Gruss Max
Mitglied: 76109
76109 23.03.2010 um 11:54:44 Uhr
Goto Top
Hallo Max!

Sorry, aber ich bin erst Heute aus dem Krankenhaus entlassen wordenface-wink

Ändere Codezeile 7 in:
Const ExternSpalteH = "H"                           'Externe Dateien Spalte H (Test Leer)  
Füge in Codezeile 8 ein:
Const ExternSpalteJ = "J"                           'Externe Dateien Spalte J (Test Wert 0)  
Ersetze Codzeile 54 und 55 durch:
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalteH))  
                        If Not IsEmpty(c.Columns(ExternSpalteH)) And c.Columns(ExternSpalteJ) <> 0 Then

Gruß Dieter
Mitglied: maxueli
maxueli 26.03.2010 um 00:36:53 Uhr
Goto Top
Hallo Guten Abend Dieter
Schlage mich immer noch mit dem Makro rum.
Habe die Ergänzung gemacht, aber es ist nicht richtig. Im Zusammenzug werden nun nur die Zeilen reingenommen, wenn in der Spalte H ein Text in einer Zelle steht.
Man könnte es doch auch so machen.
Wenn in der Spalte J eine Formel steht, deren Wert aber 0 ist, dann nicht kopieren, wenn in Spalte J aber eine Formel mit Wert steht, dann soll die ganze Zeile kopiert werden.
Alles andere funktioniert ja sehr gut, Prüfung der Spalte H wäre nicht nötig. Dort kann Text drin stehen oder eben auch nicht, die Spalte H ist massgebend.
Hoffentlich hast Du noch Geduld mit mir.
Besten Dank für Deine Hilfe.
Mitglied: 76109
76109 26.03.2010 um 08:43:02 Uhr
Goto Top
Hallo Max!

Also, wenn die Spalte H keine Rolle mehr spielt und nur noch Zeilen kopiert werden sollen, in deren Spalte J ein Wert ungleich 0 enthalten ist, dann ersetze Codezeile 54 und 55 durch:
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalteJ))  
                        If c.Columns(ExternSpalteJ) <> 0 Then

Gruß Dieter
Mitglied: maxueli
maxueli 26.03.2010 um 09:23:09 Uhr
Goto Top
Guten Morgen Dieter
Habe die Zeile 54/55 geändert.
Das Makro funktioniert noch nicht richtig, hier noch einmal das Problem:
Wenn im „Personennamen.xls“ Tabelle „_Jan“ in der Spalte J, darin sind immer Formeln enthalten. Deren Wert ist oft 0, dann sollten diese Zeilen nicht übergeben werden.
Es sollen also nur diejenigen Zeilen übergeben werden, wenn der Wert in Zelle von J auch wirklich grösser 0 ist. Jetzt kommen immer alle Zeilen.
Gruss Max
Mitglied: 76109
76109 26.03.2010 um 10:14:11 Uhr
Goto Top
Hallo Max!

Also, wenn diese beiden Codezeilen:
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalte))  
                        If Not IsEmpty(c.Columns(ExternSpalte)) Then
bzw. nach der letzten Änderung, diese beiden Codezeilen:
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalteH))  
                        If Not IsEmpty(c.Columns(ExternSpalteH)) And c.Columns(ExternSpalteJ) <> 0 Then                    
durch diese Codezeilen ersetzt wurden:
                    For Each c In WksX.Rows(ExternStart & ":" & GetEndLine(WksX, ExternSpalteJ))  
                        If c.Columns(ExternSpalteJ) <> 0 Then
dann sollte es funktionieren. Dann werden Zeilen deren Formelergebnis in Spalte J tatsächlich 0 ist, nicht kopiert, wobei z.B. 0,0000000000001 nicht 0 ist. D.h. wenn Deine Formel z.B. eine Division enthält und Du anhand der Formatvorgabe nur 2 Stellen hinter dem Komma siehst und 0 anzeigt, kann es trotzdem sein, dass der tatsächliche Wert nicht 0 ist.

In diesem Fall wäre erst mal zu klären, was ist 0? Ist 0,999999 oder -0,999999 gleich 0?
Wenn ja, dann ändere:
                        If c.Columns(ExternSpalteJ) <> 0 Then
in:
                        If Fix(c.Columns(ExternSpalteJ)) <> 0 Then

Gruß Dieter
Mitglied: maxueli
maxueli 26.03.2010 um 11:47:24 Uhr
Goto Top
Hallo Dieter
In der Tabelle „Personennamen.xls“ in Spalte J ist die folgende Formel enthalten:
=WENN(SUMME(K8:AO8)>0;SUMME(K8:AO8);"")
Mit diesem Eintrag wollte ich erreichen, dass wenn 0, das Ergebnis für das Makro nicht ausgewertet werden muss, also Zeile nicht kopieren,
d. h. entweder hat es ein Wert, dann wird angezeigt, oder kein Wert, dann bleibt die Zelle leer.
Wenn nun also die Zelle für mich leer ist, dann holt das Makro doch die ganze Zeile, aber die Zelle in der Spalte J ist im „Zusammenzug“ leer.
Die Zeile wird angezeigt obwohl ich kein Eintrag in der Spalte J sehe. Warum?
Ansonsten läuft das Makro schon gut.
Gruss Max
Mitglied: maxueli
maxueli 26.03.2010 um 12:18:27 Uhr
Goto Top
Hallo Dieter

es geht jetzt die Formel war falsch, muss =SUMME(K8:AO8)
Somit ist nun alles klar. Tut mir leid das ich Dich immer wieder darum bemühen musste.
Ich konnte aber auch viel lernen.
Besten Dank, machs guet
Tschüss MAx
Mitglied: 76109
76109 26.03.2010 um 12:50:07 Uhr
Goto Top
Hallo Max!

Bei der ursprünglichen Formel hättest Du dann nicht auf 0 sondern auf Leer hinweisen müssen. 0 und Leer ist nicht das gleiche, aber dann hätte man anstatt <> 0 einfach durch <> "" ersetzen könnenface-wink

Gruß Dieter
Mitglied: Midivirus
Midivirus 22.06.2010 um 13:33:48 Uhr
Goto Top
Mitglied: maxueli
maxueli 02.12.2012 um 17:00:37 Uhr
Goto Top
Hallo Dieter
Da bin ich nun mal wieder mit einem ganz ähnlichen Problem wie im März 2010 schon gehabt. Dal alte Makro läuft für die alte Aufgabe auch heute noch perfekt. Ich wollte das Makro für die neue Aufgabe änderen leider funktioniert es aber nicht. Kannst Du mir erneut helfen?

Hier meine neue Aufgabe:
In einem Unterordner in der Windows Verzeichnisstruktur sind 12 Excel Arbeitsmappen mit der Bezeichnung „Verbrauchsauswertung_2012_x_ZMMVS.xls (Pro Monat eine Datei) enthalten.
Diese Dateien werden aus SAP erzeugt, enhalten Verbrauchszahlen von diversen Artikel per Monat.

Einmal monatlich oder bei Bedarf, möchte ich aus den 1-12 vorliegenden Arbeitsmappen je nach Jahres-fortschritt die Werte aus der „Verbrauchsauswertung_2012_x_ZMMVS.xls“ mit einem Makro in die Arbeitsmappe „Zusammenfassung.xls“ zusammefassen. Diese Mappe hat eine Tabelle „Daten-Import“.
Die Daten in den „Verbrauchsauswertung_2012_x_ZMMVS.xls“ liegen im Arbeitsblatt "Format" wie folgt vor: Text = Spalte A,B,C; Standard: D,E,F,G,H.
Das Makro sollte sich in der Arbeitsmappe „Zusammenfassung.xls" befinden.
Bei der Ausführung holt das Makro in den 1-12 voliegenden „Verbrauchsauswertung_2012_x_ZMMVS.xls“ in der Tabelle „Format“ ab Zelle A4 bis Spalte H(Zeilenanzahl nach unten in der Tabelle Format ist variabel) die Daten und kopiert diese als „Werte“ in die Arbeitsmappe "Zusammenfassung.xls in Tabelle „Daten-Import“ untereinander beginnend in Zeile 7. Dazwischen sollten wenn möglich die Daten vom nächsten „Verbrauchsauswertung_2012_x_ZMMVS.xls eingefügt werden eine Leerzeile eingefügt werden.

Wenn das Makro im nächsten Monat erneut ausgeführt wird, sollen die Daten wiederum von Tabelle „Format" geholt werden. Die alten Werte in der Tabelle „Daten-Import“ ab Zeile 7 wieder alle gelöscht werden.
Die ersten 6 Zeilen in der Tabelle „Daten-Import“ sollen durch das Makro nicht bearbeitet werden, weil Kommentare und Text in diesem Bereich stehen..
Ich hoffe, dass ich meine Aufgabe für Dich nachvollziehbar formuliert habe.

Freundlichen Grüsse
Max
Mitglied: 76109
76109 03.12.2012 um 09:31:00 Uhr
Goto Top
Hallo Max!

Eröffne bitte einen neuen Thread (Beitrag) und kopiere Deinen letzen Post in den neuen Thread und füge einen Link zu diesem Beitrag mit ein...

Sonst wird das Ganze für andere Suchende zu Unübersichtlichface-wink

Gruß Dieter