wo genau befindet sich der Blattschutz, in der Quelle- oder Zieldatei?? Den können wir per VBA aufheben und wiedereinschalten. Mit und ohne Passwort. Dazu muss ich aber wissen wo er sich befindet, dann kann ich dir die Befehle im Code einbauen.
Versuchweise gebe ich dir mal die Protect Befehle für die Zieldatei an. ShtX.Unprotect '"PW" ** hier ggf. dein Passwort angeben - vor lz1, lz2 den Blattschutz aufheben! lz1 = ShtX.Cells(Rows.Count, 1).End(xlUp).Row lz2 = ShtX.Cells(Rows.Count, 4).End(xlUp).Row
ShtX.Protect '"PW" ** hier ggf. MIT Passwort wieder einfügen - vor Save den Blattschutz wiederherstellen WbEx.Save 'Stundennachweis Save
Wenn es KEIN Passwort gibt nur Protect und Unptotect verwenden, sonst das Passwort in "xxx" setzen. Du kannst ja in einer leeren Exceldatei den Blattschutz setzen und aufheben zum Testen üben. Ich hoffe diese Info hilft dir weiter.
mfg Gast 123
Der Blattschutz ist auf der Quelldatei und ist mit Passwort geschützt, genau. Demzufolge müsste der Code dann so aussehen oder: .... .... Liste: ThisWorkbook.Activate Set WbEx = Workbooks(Klient) Set ShtX = WbEx.Sheets(1) ShtX.Unprotect '"PW" lz1 = ShtX.Cells(Rows.Count, 1).End(xlUp).Row lz2 = ShtX.Cells(Rows.Count, 4).End(xlUp).Row .... .... .... If ü > 0 Then MsgBox Klient & " Stundenabrechnung" & vbLf _ & ü & " Zeilen Überlauf", vbInformation ShtX.Protect '"PW" WbEx.Save 'Stundennachweis Save 'Schliessen wenn KEIN Überlauf! If ü = 0 Then WbEx.Close False Return
jetzt bin ich etwas verwirrt, ich dachte der Blattschutz sei in der Zieldatei? Dann stimmt mein Code NICHT!
Ich habe mir das Makro noch mal angesehen, es gibt nur eine Stelle wo der Blattschutz uns stören kann! Wenn die Zellen X2 bis Z 5 gesperrt sind, kann mein Makro das -Kopier Ergebnis- nicht hineinschreiben! Weil diese Zellen für deine Mitarbeiter nicht relevant sind, kann uns keiner darin rummutschen! Wenn du diese Zellen auf "Unlocked" setzt, brauchen wir den Blattschutz NICHT aufheben!
Diese Zellen beeinflussen ja nicht eure Arbeit, sie dienen nur zur Information ob alles geklappt hat.
jetzt bin ich etwas verwirrt, ich dachte der Blattschutz sei in der Zieldatei? Dann stimmt mein Code NICHT!
Ich habe mir das Makro noch mal angesehen, es gibt nur eine Stelle wo der Blattschutz uns stören kann! Wenn die Zellen X2 bis Z 5 gesperrt sind, kann mein Makro das -Kopier Ergebnis- nicht hineinschreiben! Weil diese Zellen für deine Mitarbeiter nicht relevant sind, kann uns keiner darin rummutschen! Wenn du diese Zellen auf "Unlocked" setzt, brauchen wir den Blattschutz NICHT aufheben!
Diese Zellen beeinflussen ja nicht eure Arbeit, sie dienen nur zur Information ob alles geklappt hat.
mfg Gast 123
Hallo Gast,
du hattest mal wieder Recht. Mit Setzen der Zellen X2 bis Z 5 (reicht nicht auch X2 bis Y5?) auf "Unlocked" klappt es wieder einwandfrei ohne Fehlermeldung
Nun, mal wieder , noch eine Sache, die mir gerade einfällt, wenn ich das Ganze dann auf 30 Klienten, oder mehr, hochskaliere. Für den Fall, dass ich irgendeine Stelle im Code übersehe, welche dahingehend angepasst werden muss. Ich muss logischerweise neue evtl. abweichende Pfade für die Abrechnungen einfügen --> Const MyPfad Ich muss weitere Variablen für die Abrechnungsdateien festlegen --> Const "Name des Klienten" = "ASD Nachname, Vorname_04_2024.xlsx" Ich muss diese wiederum darunter einfügen -->
On Error Resume Next Set WbEx = Workbooks(Name) If Err > 0 Then Workbooks.Open Filename:=MyPfad & Name Set WbEx = Workbooks(Name) Klient = "Name wie er in der Datei zu finden ist": GoSub Liste
Und ich muss doch den Range von X2 bis Y5 mit den neuen Namen erweitern bis, keine Ahnung Y20, je nachdem wie viele Klienten ich auswerten will, oder?
21.05.2024, 11:47 (Dieser Beitrag wurde zuletzt bearbeitet: 21.05.2024, 11:49 von Gast 123.)
Hallo
du hast inzwischen VBA ganz gut verstanden. Aber bitte auf Spalte Z erweitern, weil das Makro bei Datei Öffnen Fehler in Spalte Z eine "Öffnen Error" Meldung ausgibt. Die kommt ja auch NUR bei Datei Öffnen Fehlern, sonst nicht! Den Bereich kannst du Problemlos nach unten beliebig erweitern. Da gibt es keine Grenzen.
Wenn du viele Mitarbeiter hast, ca. 20-30, wäre zu überlegen in den Spalten ab Z jeweils den Pfad und Dateinamen in eine eigene Zelle abzulegen. Die Spalten um Pfad und Dateinamen erweitern. Dann könnte ich diese Daten aus den Zellen laden. Diese Zellen mit Pfad und Dateiname sollten aber bitte auf "Locked" gesetzt werden, damit sie nicht versehentlich gelöscht werden. Du kannst dir ja bitte selbst etwas ausdenken, wie es dir am besten passt, und als Beispieldatei hochladen. Dann schaue ich mal ob wir das Makro auf diese neue Aktion umschreiben können.
Ich denke das würde für dich die Sache noch mal vereinfachen. Sind aber erheblich Änderungen am bisherigen Makro. Macht aber Spass die Sache zu optimieren. Ist mein persönlicher Ehrgeiz. Freut mich aber das es bisher so gut klappt!
mfg Gast 123 Nachtrag wenn wir die Daten aus Zellen laden kann ich mit einer For Next Schleife arbeiten. Das vereinfacht bei so vilen Personen die Sache erheblich. Ich brauche aber genug Zeit um das zu realisieren. Sezte mich heute Abend mal aus Spass dran.
ich habe dir diese Beispieldatei auf For Next umgestellt. Dazu benötige ich Dateiname + Pfad in den Spalten X+Y. Dieses Makro ist für max. 200 Personen ausgelegt, ich denke das wird für euch reichen. (Kann noch weiter gehen) Bitte den ganzen Code kopieren, da hat es doch einige Änderungen gegeben.
Die Zellen Z2:AB50 oder AB100 bitte auf Unlocked setzen. Stört ja nicht wenn es mehr sind als benötigt wird. Ich bin gespannt wie sich diese Variante in der Praxis bewährt. Das Auflisting Programm ist gleich geblieben. Nur ein paar Änderungen wo sich die Spalten verschoben haben.
mfg Gast 123
PS Weil mein PC nur einen kleinen Bildschrim hat habe ich die Schriftgrösse für X+Y stark verkleinert.
ich habe dir diese Beispieldatei auf For Next umgestellt. Dazu benötige ich Dateiname + Pfad in den Spalten X+Y. Dieses Makro ist für max. 200 Personen ausgelegt, ich denke das wird für euch reichen. (Kann noch weiter gehen) Bitte den ganzen Code kopieren, da hat es doch einige Änderungen gegeben.
Die Zellen Z2:AB50 oder AB100 bitte auf Unlocked setzen. Stört ja nicht wenn es mehr sind als benötigt wird. Ich bin gespannt wie sich diese Variante in der Praxis bewährt. Das Auflisting Programm ist gleich geblieben. Nur ein paar Änderungen wo sich die Spalten verschoben haben.
mfg Gast 123
PS Weil mein PC nur einen kleinen Bildschrim hat habe ich die Schriftgrösse für X+Y stark verkleinert.
Hallo Gast,
auch diese Variante klappt wunderbar. Ich danke dir Ich habe nur noch nicht richtig den Sinn der Änderung verstanden. Ist das jetzt vom Code her effizienter bzw. übersichtlicher wenn wir die Dateien und Pfade in die Zellen schreiben oder wo genau ist der Hintergrund?
Und nochmal zum Verständnis der OpenError-Spalte. Diese wird nur beschrieben, wenn beim Ausführen des Makros eine Abrechnung geöffnet ist, richtig? Quasi als Reminder, dass man die Abrechnung bitte schließen soll?
22.05.2024, 18:05 (Dieser Beitrag wurde zuletzt bearbeitet: 22.05.2024, 18:11 von Gast 123.)
Hallo
in AW 33 hast du ja selbst den Set Block eingefügt, der vorher im alten Code für JEDEN Mitarbeiter einzeln ausgefüllt werden musste. Das wäre für dich bei 30 Mitarbeitern viel Schreibarbeit, der Code würde sehr lang werden. Fehlermöglichkeiten sind da eher gegeben.
Im neuen Code gibt es nur einen SET Block, da ändern sich dann die Mitarbeiter, Pfad- und Dateinamen über die Zellen Informationen! Deine Zellen müssen natürlich stimmen, aber das ist nur einmal Schreibarbeit. Sind die Zellen danach geschützt kann da nix passieren! Es erspart dir viel Schreibarbeit, denn du müsstest ja sonst im Code für 30 Mitarbeiter 60 Const Anweisungen (Pfad, Datei) ausfüllen!
Open Error heisst, beim - Datei Öffnen - ist ein Fehler entstanden, weil der Pfad- oder Dateiname NICHT stimmt! Diese Zelle wird also NUR im Fehlerfalle angezeigt, sonst bekommst du dort keine Meldung.
Wenn das Makro einen Überlauf feststellt, bekommst du den Überlauf angezeigt. Sonst bleiben diese Zellen LEER! Im Normalfall wird jede Mitarbeiter Datei automatisch geschlossen, nur die - ÜBERLAUF Dateien - bleiben offen. Das gibt dir die Möglichkeit dort weitere Zeilen einzufügen und das kopieren noch mal komplett zu wiederholen.
mfg Gast 123 PS Viel Erfolg bei eurer Arbeit mit diesem Code. Hat Spass gemacht ihn zu entwickeln. PS Bitte die Spalten W, X, Y für Mitarbeiter, Pfad- und Dateiname nach der Eingabe auf "Locked" für den Blattschutz setzen.
in AW 33 hast du ja selbst den Set Block eingefügt, der vorher im alten Code für JEDEN Mitarbeiter einzeln ausgefüllt werden musste. Das wäre für dich bei 30 Mitarbeitern viel Schreibarbeit, der Code würde sehr lang werden. Fehlermöglichkeiten sind da eher gegeben. -->Macht Sinn
Im neuen Code gibt es nur einen SET Block, da ändern sich dann die Mitarbeiter, Pfad- und Dateinamen über die Zellen Informationen! Deine Zellen müssen natürlich stimmen, aber das ist nur einmal Schreibarbeit. Sind die Zellen danach geschützt kann da nix passieren! Es erspart dir viel Schreibarbeit, denn du müsstest ja sonst im Code für 30 Mitarbeiter 60 Const Anweisungen (Pfad, Datei) ausfüllen! -->Hast du Recht, leuchtet ein!
Open Error heisst, beim - Datei Öffnen - ist ein Fehler entstanden, weil der Pfad- oder Dateiname NICHT stimmt! Diese Zelle wird also NUR im Fehlerfalle angezeigt, sonst bekommst du dort keine Meldung. -->OK geht klar, danke, verstanden!
Wenn das Makro einen Überlauf feststellt, bekommst du den Überlauf angezeigt. Sonst bleiben diese Zellen LEER! Im Normalfall wird jede Mitarbeiter Datei automatisch geschlossen, nur die - ÜBERLAUF Dateien - bleiben offen. Das gibt dir die Möglichkeit dort weitere Zeilen einzufügen und das kopieren noch mal komplett zu wiederholen. Sehr gut, vielen Dank!
mfg Gast 123 PS Viel Erfolg bei eurer Arbeit mit diesem Code. Hat Spass gemacht ihn zu entwickeln. PS Bitte die Spalten W, X, Y für Mitarbeiter, Pfad- und Dateiname nach der Eingabe auf "Locked" für den Blattschutz setzen. -->Hab ich
Hallo Gast,
mir ist leider noch etwas Essentielles eingefallen, was dich, so meine Hoffnung, nicht noch einmal allzu sehr beanspruchen wird. In den Abrechnungsdateien wird, neben dem Datum, der Zeit und dem entsprechenden Mitarbeiter, auch die Tätigkeit in der verbundenen Zelle "E,F und G" hinterlegt. Könntest du diese große verbundene Zelle einfach mit dem Inhalt der in den farblich markierten Zellen aus der Einsatzliste füllen? Quasi einfach den TextString "Alex" oder HPG Alex" oder was auch immer im Zusammenhang mit "Alex" bzw. Richard, Manu oder wem auch immer dort drinsteht übertragen? Wäre das ein großer Aufwand? Ich hoffe du verstehst was ich meine.
23.05.2024, 21:16 (Dieser Beitrag wurde zuletzt bearbeitet: 23.05.2024, 21:19 von Gast 123.)
Hallo
nein, kein großes Problem dir auch da noch zu helfen, im Augenblick habe ich aber noch nicht verstanden wo ich die Tätigkeit finde?? Ist das der Zusatztext in Zeile 5-7, z.B. "HPG Mirko"?? Falls ja kannst du den unteren Codeteil in deiner Originaldatei tauschen.
Neu eingefügt habe ich diese beiden Codezeilen. Der 1. Teil lädt den Namen mit Zusatzinfo, der zweite Befehl löscht den Klientennamen. Damit bleibt die Zusatzinfo im Stundennachweis bestehen. Liege ich da mit meiner Idee richtig?? Wenn nein erkläre es mir bitte noch mal. ShtX.Cells(z, 5) = .Cells(AC.Row + j, s) ShtX.Range("E18:E" & z).Replace Klient, "", xlPart
Hinweis: Mein erster Versuch klappte nicht, weil zu meiner Überraschung sich im Blatt Stundennachweis Alex auch ein Blatttschutz befindet. Und zwar für die verbundenen Zellen E-G, und für die Spalte H. Die Zellen sollten dann bitte auch auf "Unlocked" gesetzt werden.
Mal sehen ob meine Idee richtig liegt, sonst muss ich mir was anderes ausdenken.
mfg Gast 123
Code:
'Alle Namen (Fett) in Testmappe auswerten For Each AC In .Range("A2:A" & lz1) If AC.Font.Bold = True And AC.Value <> "" Then 'Alle Spalten mit Klientnamen übertragen For s = 2 To lsp Step 4 For j = 5 To 7 'Zeile 5 bis 7 auswerten If InStr(.Cells(AC.Row + j, s), Klient) And _ .Cells(AC.Row + j, s + 1) <> Empty Then If z < lz2 Then ShtX.Cells(z, 8) = AC.Value ShtX.Cells(z, 1) = .Cells(1, s) ShtX.Cells(z, 2) = .Cells(AC.Row + j, s + 1) ShtX.Cells(z, 3) = .Cells(AC.Row + j, s + 2) '** 23.5. MTA eingefügt (mit Info) ShtX.Cells(z, 5) = .Cells(AC.Row + j, s) z = z + 1 Else ü = ü + 1 'Überlauf Zähler End If End If Next j Next s End If Next AC '** der Klientname wird hier gelöscht! ShtX.Range("E18:E" & z).Replace Klient, "", xlPart
Du brauchst meinen Text aber nicht jedesmal zu wiederholen. Ich verstehe auch so deine Antwort.
Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:1 Nutzer sagt Danke an Gast 123 für diesen Beitrag 28 • Dschissl
du hast es, mal wieder, exakt so verstanden und umgesetzt, wie ich es meinte und mir vorstellte, eine Glanzleistung, danke dir, klappt auf Anhieb. Eigentlich hast du sogar, wahrscheinlich intuitiv, weiter gedacht Ich meinte es ursprünglich so, dass der gesamte TextString, also auch der Klientenname mit in die verbundene Zelle übertragen wird, was ja aber quatsch ist, weil es sich ja um die Abrechnungsdatei eben des Klienten handelt. Wieso sollte da also nochmal sein Name mit drinstehen. Der Zusatztext allein z.B. HPG oder OKG, oder was auch immer, macht viel mehr Sinn. Super Arbeit. So ich hoffe das wars jetzt auch an dieser Stelle. Vielleicht war das ja auch für den einen oder anderen nützlich, der hier mitgelesen hat. Laut Forums-Icon und den Views ist das ja ein "heißes" Thema
Übertragung multipler Daten aus einer Datei in andere Dateien
, noch eine Sache, die mir gerade einfällt, wenn ich das Ganze dann auf 30 Klienten, oder mehr, hochskaliere. 
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
