211 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo liebe Excelfangemeinde,

ich habe ca. 30 gleich aufgebaute Dateien, die ich immer an der selben Stelle in jeder Datei mit Daten überschreiben will.

Dazu bedarf es auch, dass ich in jeder Datei und Tabellenblatt einen Schreibschutz hinterlegt habe, den ich dann zunächst einmal ausschalten muss.

Das Makro läuft immer identisch für jede einzelne Gruppe ab:  Kopiere Dir die Daten im Tabellenblatt von Haupt-Menü - gehe dann in die erste Gruppe - blende das Fenster Pk-Name ein - schalte den Blattschutz aus - und füge die Daten ein. Nach der Übertragung dann wieder den Blattschutz einschalten, das Tabellenblatt PK-Name wieder ausblenden und wenn der Cursor im Blatt Anwesend steht, das Gruppenblatt speichern und schließen.

Nach Durchlauf des ersten Gruppenblattes dann zum nächsten gehen und das alles wiederholen....  letztendlich ca. 30 x.

Die ersten Gruppen laufen eigentlich immer durch, aber dann irgendwann kommt das Makro zum stoppen und kann nur noch mit Abbruch beendet werden.

Da die ersten Gruppen ja fehlerfrei durchlaufen und die Abbrüche auch schon mal an unterschiedlichen Stellen stattfinden, muss es etwas anderes sein, was mir den kompletten Durchlauf verhagelt.

Meine Vermutung liegt im Zwischenspeicher, dass ich mir da zu viel Daten reinknalle.

Habe mir auch schon überlegt, ob ich die Übertragung nur Gruppenweise durchführen sollte (max. 10 Gruppen) und dann mal schauen, ob es dann auch wieder zu Abbrüchen führt.

Evtl. hat aber auch jemand von Euch eine andere Idee, wenn er sich das Makro ansieht, dass man da was einfacher machen kann..

Ich bedanke mich schon mal für Euer Interesse und wünsche allen noch einen schönen Tag... MfG... Helmut

Sub Personuebertragen()

Application.ScreenUpdating = False

'**********************   GRUPPE 2  ***************************************************
    ChDir "G:\Fertigung\Abrechnung\Gruppe 02\2022"
    Workbooks.Open Filename:= _
        "G:\Fertigung\Abrechnung\Gruppe 02\2022\Vorlage_Gruppe_02_2022.xlsm"
    Sheets("Anwesend").Select
    Sheets("Pk-Name").Visible = True
    Sheets("Pk-Name").Select
    ActiveSheet.Unprotect Password:="XXX"
    Range("B2:C2100").Select
    Selection.ClearContents
    Range("B2").Select
    Windows("Haupt-Menue.xlsm").Activate
    Range("J5:K2000").Select
    Selection.Copy
    Windows("Vorlage_Gruppe_02_2022.xlsm").Activate
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Pk-Name").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Pk-Name").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Anwesend").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
'***************************** GRUPPE 4  *********************************************
    ChDir "G:\Fertigung\Abrechnung\Gruppe 04\2022"
    Workbooks.Open Filename:= _
        "G:\Fertigung\Abrechnung\Gruppe 04\2022\Vorlage_Gruppe_04_2022.xlsm"
    Sheets("Anwesend").Select
    Sheets("Pk-Name").Visible = True
    Sheets("Pk-Name").Select
    ActiveSheet.Unprotect Password:="XXX"
    Range("B2:C2100").Select
    Selection.ClearContents
    Range("B2").Select
    Windows("Haupt-Menue.xlsm").Activate
    Range("J5:K2000").Select
    Selection.Copy
    Windows("Haupt-Menue.xlsm").Activate
    Range("J5:K2000").Select
    Selection.Copy
    Windows("Vorlage_Gruppe_04_2022.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Pk-Name").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Pk-Name").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Anwesend").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close

3 Antworten

0 Punkte
Beantwortet von
Hi,

habe mir zwischenzeitlich mal den Befehl zum Zwischenspeicher löschen herausgesucht und nach jedem fünften Gruppendurchlauf eingesetzt. Mal schauen ob es ohne Probleme durchläuft.

Den Durchlauf kann ich allerdings erst morgen laufen lassen, wenn niemand mehr an den Rechners ist, damit keine Datei mehr geöffnet ist, auf die ich zugreifen möchte.

Der Befehl für diejenigen, die das auch interessiert, lautet:   Application.CutCopyMode = False

In diesem Sinne... have a nice Day and WE.... MfG... Helmut
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Bearbeitet von m-o

Hallo Helmut,

mit dem Befehl

Application.CutCopyMode = False

wird die aktuelle Auswahl zum Kopieren aufgehoben oder wie Microsoft schreibt:

Bricht den Ausschneide- bzw. Kopiermodus ab und entfernt den Laufrahmen.

Willst du die Zwischenablage leeren, musst du das wie folgt machen:

Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard& Lib "user32" ()
 
Public Sub ClearClipboard()
OpenClipboard 0&
EmptyClipboard
CloseClipboard
End Sub

Ich würde auch mal nachschauen, ob in bestimmten Tabellen umfangreiche Berechnungen vorhanden sind, die eventuell das System bremsen (z.B. viele Indirekt-Formeln). Du kannst die Gruppen ja auch mal einzeln laufen lassen.

Du kannst ja mal probehalber die automatische Berechnung am Anfang des Makros ausschalten und am Ende wieder einschalten:

'automatische Berechnung ausschalten:
Application.Calculation = xlManual

'automatische Berechnung einschalten:
Application.Calculation = xlAutomatic

Du arbeitest natürlich viel mit Select. Das kann man sich in vielen Fällen sparen. Das sollte allerdings nicht der Grund für die Probleme sein.

Du aktivierst ja nur die Arbeitsmappe Haupt-Menu.xlsm (aus der wohl das Makro ausgeführt wird). Hier würde ich zur Klarstellung auch noch das entsprechende Arbeitsblatt angeben (man weis ja nie wink).

Wenn du immer die selben Daten einfügst, brauchst du auch nicht die Daten mehrmals kopieren. Einmal reicht aus, wie in dem folgenden Beispielcode:

Sub kopieren()

Dim wbZiel As Workbook

ActiveSheet.Range("A1:C2").Copy

Set wbZiel = Workbooks.Open("C:\Users\test\Documents\Test1.xlsx")

With wbZiel
  With .Worksheets("Tabelle1").Range("B2")
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  End With
  .Close (True)
End With

Set wbZiel = Workbooks.Open("C:\Users\test\Documents\Test2.xlsx")

With wbZiel
  With .Worksheets("Tabelle1").Range("B2")
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  End With
  .Close (True)
End With

Application.CutCopyMode = False

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von
Hallo M.O.,

vielen Dank für Deine Informationen und entdecke die Möglichkeiten...

Ich habe mir schon gedacht, dass man das sicherlich einfacher mit dem kopieren machen kann, aber halt... gewusst wie??? , so dass ich Deine letzte Info mal bei Gelegenheit testen werde.

Das mit dem Zwischenspeicher löschen habe ich dann vorher bei anderen Informationen zu dem Thema wohl falsch verstanden, da Du ja ein eigenes Makro daraus gemacht hast und ich nur die eine Zeile nutzen wollte.

Diese Zeile hatte ich jetzt nach jedem fünften kopieren eingefügt und diesmal ist die Übertragung auch bis zum Ende durchgelaufen. Aber damit das auf jeden mit dem Löschen klappt werde ich noch die Anpassung von Dir vornehmen.

Vielen vielen Dank für Deine Unterstützung und wünsche allen Interessierten noch eine schöne und stressfreie Restwoche....  MfG... Helmut
...