Új hozzászólás Aktív témák

• #19299 rtom senior tag

  Új Válasz 2013-10-14 20:36:25 #19299

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  rtom

  senior tag

  Szevasztok!

  Megint elakadtam egy makróval, egy táblázat beolvas nevű füléről a bevitt (kézi vonalkód szkennerrel beolvasott) adat függvényében egy másik lapra másolok, a makrónak kéne feloldania a lapvédelmet a cél lapon, de mihelyst bekapcsolom a lapvédelmet, elakad a másolásnál, ebből arra következtetek, hogy nem sikerül feoldani a lapvédelmet, de hogy miért, azt nem értem. Lapvédelem nélkül jól működik. A kód:

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  Dim usor, usor2, lReply As Long
  Dim lapnev As String
  If Range("A2") <> Empty And Range("A4") = "OK" Then
  Range("D2").Copy
  lapnev = Range("F2")
  Sheets(lapnev).Select
  Sheets(lapnev).Unprotect Password:="xy"
  usor = WorksheetFunction.CountA(ActiveSheet.Range("b6:b13"))
  usor = usor + 6
  usor2 = WorksheetFunction.CountA(ActiveSheet.Range("e6:e13"))
  usor2 = usor2 + 6
  If usor = 14 Then
  If usor2 = 14 Then
  lReply = MsgBox("Betelt a lap, nyomtass!", vbOK)
  Exit Sub
  Else: ThisWorkbook.Sheets(lapnev).Range("E" & usor2).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  End If
  Else: ThisWorkbook.Sheets(lapnev).Range("B" & usor).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  End If
  Sheets(lapnev).Protect Password:="xy", DrawingObjects:=False, Contents:=False, Scenarios:=False _
  , AllowUsingPivotTables:=False, AllowFiltering:=False
  Sheets("beolvas").Select
  Range("A6").Select
  Selection.ClearContents
  End If
  End Sub

Új hozzászólás Aktív témák