Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro mit PW, aber trotzdem Abfrage
#1
Hallo, 

habe ein Makro geschrieben, wo ich wenn eine bestimmte Bedingung erfüllt ist die Zeilen in einen neuen Reiter kopieren lasse.
Allerdings soll dieser Reiter schreibgeschützt sein.

Also mein Makro:

Password aufheben--> Zeilen kopieren--> Password setzen!

nun frag er mich jedesmal nach dem Password, wenn ich die Excel neu starte!

Kann mir da wer helfen?






Sub kopieren() 
 ActiveSheet.Unprotect Password:="test2000"
 Range("A9:Bg500").Clear
  Application.ScreenUpdating = False
  Dim myRow As Long
 Dim myLastRow1 As Long
 Dim myLastRow2 As Long
  With Sheets("02")
     myLastRow1 = .Cells(Rows.Count, 26).End(xlUp).Row
     If myLastRow1 < 9 Then Exit Sub
 End With 
 For myRow = 9 To myLastRow1
      If Sheets("02").Cells(myRow, 26).Value = "ja" Then
              With Sheets("01")
             myLastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
             If myLastRow2 < 8 Then myLastRow2 = 8
         End With
           Sheets("02").Rows(myRow).Copy Destination:=Sheets("01").Rows(myLastRow2 + 1)
          End If
  Next myRow 
  Application.ScreenUpdating = True   
  ActiveSheet.Protect Password:="test2000"
  ActiveSheet.Protect userinterfaceonly:=True
  ActiveSheet.EnableAutoFilter = True
 
 End Sub
Antworten Top
#2
Hallo,

teste es mal so. Jetzt spielt es keine Rolle, welches Blatt gerade aktiv ist.
Sub kopieren()
 Dim myRow As Long
 Dim myLastRow1 As Long
 Dim myLastRow2 As Long
   
 myLastRow1 = Sheets("02").Cells(Rows.Count, 26).End(xlUp).Row
 If myLastRow1 > 8 Then
   Application.ScreenUpdating = False
   With Sheets("01")
     .Unprotect Password:="test2000"
     .Range("A9:Bg500").Clear
     For myRow = 9 To myLastRow1
       If Sheets("02").Cells(myRow, 26).Value = "ja" Then
         myLastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
         If myLastRow2 < 8 Then myLastRow2 = 8
         Sheets("02").Rows(myRow).Copy Destination:=.Rows(myLastRow2 + 1)
       End If
     Next myRow
     .Protect Password:="test2000", UserInterfaceOnly:=True
     .EnableAutoFilter = True
   End With
   Application.ScreenUpdating = True
 End If
End Sub
Gruß Uwe
Antworten Top
#3
Guten Morgen,

so funktioniert es leider nicht,

kommt zwar keine PW abfrage mehr, allerdings löscht er mir jetzt auch die Originalliste

in 01 werden Daten erfasst und in 02 werden Daten reinkopiert, wenn in 01 bestimmte Bedingung erfüllt ist.

MfG
Antworten Top
#4
Hallo,

(15.07.2016, 06:01)KS20 schrieb: allerdings löscht er mir jetzt auch die Originalliste

die Zeile
Range("A9:Bg500").Clear
war aber von Dir.

(15.07.2016, 06:01)KS20 schrieb: in 01 werden Daten erfasst und in 02 werden Daten reinkopiert, wenn in 01 bestimmte Bedingung erfüllt ist.

In Deinem Code war es genau andersrum und daran hielt ich mich. Wink

Gruß Uwe
Antworten Top
#5
Hallo Uwe,

Danke!

War mein Fehler, hatte die Reiter verwechselt^^

Nun funktioniert es viele DANK !!!!!
Antworten Top


Gehe zu:


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