Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
728to732
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

trotz Blattschutz kopieren und einfügen

trotz Blattschutz kopieren und einfügen
HansHei
Hallo Excel-Freunde,
ich habe ein Problem mit folgendem Makro. Ich möchte Daten aus einer geöffneten Datei in eine ausgewählte Datei kopieren. Dabei soll die Zieldatei geöffnet, entsprechende Werte eingefügt und wieder geschlossen werden. Das funktioniert, wenn die Zieldatei keinen Blattschutz hat; also beim ersten Mal ohne Probleme. Danach ist der Blattschutz gesetzt. Wiederhole ich den Vorgang, bleibt alles in der Zeile Selection.PasteSpezial..." hängen. Was mach ich falsch oder wie mach ichs besser?

Sub Daten_aktualisieren()
Application.DisplayAlerts = False
Range("C3:F20").Copy
'Application.Dialogs(xlDialogOpen).Show 'aktivieren des Dialogs
Workbooks.Open Filename:="D:\Meine_Dateien_neu\Hans\Zieldatei2.xls"
Sheets("Tabelle1").Select
ActiveSheet.Unprotect Password:=""
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect Password:=""
ActiveWorkbook.Close True
Application.DisplayAlerts = True
End Sub

Danke und Gruß
Hans

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: trotz Blattschutz kopieren und einfügen
11.02.2006 17:54:12
Luschi
Hallo Hans,
setze den Blattschutz wie folgt:
ActiveSheet.Protect Password:="", UserInferfaceOnly:=True
Der Zusatz "UserInferfaceOnly:=True" bedeutet, das für den Anwender, der Daten per Tastatur in die Tabelle einträgt, der Blattschutz voll aktiviert ist; daß man aber mit Vba in gesperrte Zellen der geschützten Tabelle Werte ändern kann.
Leider vergißt Excel beim Schließen der Arbeitsmappe diesen Schutz-Zusatz.
Wenn man die Mappe wieder öffnet, sind die geschützten Zellen in Tabellen auch für Vba wieder gesperrt.
Deshaln ändere den Code so ab:
Sub Daten_aktualisieren()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("C3:F20").Copy
'Application.Dialogs(xlDialogOpen).Show 'aktivieren des Dialogs
Workbooks.Open Filename:="D:\Meine_Dateien_neu\Hans\Zieldatei2.xls"
WorkSheets("Tabelle1").Select
'Prüfen, ob die Tabelle geschützt ist
If WorkSheets("Tabelle1").ProtectContents Then
ActiveSheet.Unprotect Password:=""
End If
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
ActiveWorkbook.Close True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: trotz Blattschutz kopieren und einfügen
11.02.2006 19:07:26
HansHei
Danke Luschi,
aber das Problem bleibt leider bestehen. Ich habe bei der If-Abfrage noch eine kleine Ergänzung reingebaut,
If Worksheets("Tabelle1").ProtectContents = True Then
Hat aber auch nicht weitergeholfen.
Der Laufzeitfehler 1004 lautet weiterhin:
"Die PasteSpecial-Methode des Range-Objektes konnte nicht ausgeführt werden."
Die Zieldatei ist nach beenden des Debuggers geöffnet und hat keinen Blattschutz. Wenn ich dann versuche noch per Hand einzufügen geht dies nicht, das "Einfügen" im Contextmenü ist deaktiviert. Es sieht so aus, als wenn die Zwischenablage geleert ist, oder "Copy" garnicht stattfand.
Gruß
Hans
Anzeige
AW: trotz Blattschutz kopieren und einfügen
11.02.2006 21:21:05
Ramses
Hallo
wenn du glaubst dass der Copy-Befehl nicht ausgeführt, stell doch den Code einfach um
Option Explicit

Sub Daten_aktualisieren()
    Dim mySWB As Workbook, mySWks As Worksheet
    Dim tarWb As Workbook, tarWks As Worksheet
    Set mySWB = Workbooks(ThisWorkbook.Name)
    Set mySWks = mySWB.Worksheets("Tabelle1") 'dort wird kopiert
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    On Error Resume Next
    'Variabel
    'Set tarWb = Application.GetOpenFilename("EXCEL-Files (*.xls) *.xls", , "Datei öffnen", , False)
    'oder fest
    Set tarWb = Workbooks.Open("D:\Meine_Dateien_neu\Hans\Zieldatei2.xls")
    Set tarWks = tarWb.Worksheets("Tabelle1")
    If tarWks.ProtectContents Then
        ActiveSheet.Unprotect Password:=""
    End If
    With mySWks
        .Range("C3:F20").Copy
        tarWks.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
    ActiveWorkbook.Close True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Gruss Rainer
Anzeige
AW: trotz Blattschutz kopieren und einfügen
11.02.2006 22:50:32
HansHei
Hallo Rainer,
"wenn du glaubst dass der Copy-Befehl nicht ausgeführt, stell doch den Code einfach um"
Wenn das für mich als Autodidakt (gelernter Autoschlosser, Oldie Bj:1953, der seit 2 Jahren seine Brötchen als Buchhalter verdient) so einfach wäre,- auf jeden Fall klappts, Danke!!!
Ich habe das Ganze mittlerweile noch einmal ohne jeden Schutz neu aufgebaut und wollte die Blattschutzgeschichten "pö a pö" einbauen. Also werde ich erst mal Deinen Vorschlag studieren. Insbesondere die Dim`s und Set`s. ;-)
Ich geb meinen "Glauben" nicht auf.
Danke
Hans
Anzeige
AW: Nachtrag
11.02.2006 23:30:39
HansHei
Moin Rainer,
hab das jetzt für mich so umgesetzt:

Sub Daten_übertragen()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Application.Dialogs(xlDialogOpen).Show 'aktivieren des Dialogs
    Workbooks.Open Filename:="D:\Meine_Dateien_neu\Hans\Zieldatei2.xls"
        If Worksheets("Tabelle1").ProtectContents Then
        ActiveSheet.Unprotect Password:=""
        End If
    Windows("Daten2.xls").Activate
    Sheets("Tabelle1").Select
    Range("C3:F20").Copy
    Windows("Zieldatei2.xls").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ActiveSheet.Protect Password:="", UserInterfaceOnly:=True
ActiveWorkbook.Close True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Warum es vorher nicht klappte muss ich mir noch mal ansehen. Danke nochmals und
Gruß Hans
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige