Soru Korumalı Sayfayı Değere Dönüştürerek Kopyalama

[incsoft]

Arkadaşlar bir dosyam var ve bu dosya da belli hücrelerim kilitli ve bunları kopyala özel yapıştır değerleri dediğimde hata vermektedir. Bunu yapabilmek için nasıl bir macro kullanabilirim? Bu macroyu kendi komutlarımın içine adapte edeceğim.

Teşekkürler..

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Çalışan makronuzun ilk satırına ActiveSheet.Unprotect "şifreniz" ve son satırına ActiveSheet.Pprotect "şifreniz" yazıp deneyin.
İyi çalışmalar

 

[incsoft]

Merhaba Arkadaş,
Çalışan makronuzun ilk satırına ActiveSheet.Unprotect "şifreniz" ve son satırına ActiveSheet.Pprotect "şifreniz" yazıp deneyin.
İyi çalışmalar

Hocam komutlar doğru olabilir ancak benim macromda sorun çıkardı. Birkaç farklı yerde denedim yine olmadı. Korumam sayfada aynı zamanda

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Şifreli sayfadan kopya alamazsınız. Benim satırlardan birincisi şifreyi kaldırıyor, makro işlevini yerine getiriyor ve sonrasında da sayfa yeniden şifreleniyor.
Hepsi bu. Yine olmuyorsa örnek dosya koyarsanız bir arkadaşımız bakar mutlaka.
İyi çalışmalar

 

[incsoft]

Sub ARIZA_Genderme_Mail()
ActiveSheet.Pprotect "knk963"
Dim Yol As String, Yedek As String, Dosya As String
Dim Uygulama As Object, Yeni_Mail As Object
Dim FSO As Object, Sayfa As Worksheet
Dim S1 As Worksheet, Onay As Byte, Mesaj As String
On Error Resume Next
Set Uygulama = GetObject(, "Outlook.Application")
On Error GoTo 0

If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)

Set Uygulama = VBA.CreateObject("Outlook.Application")
Set Yeni_Mail = Uygulama.CreateItem(0)
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")

Set S1 = Sheets("yazma")
Set s2 = Sheets("1")
Set S3 = Sheets("Kayıtlar")

Yol = ThisWorkbook.Path & Application.PathSeparator

Yedek = Yol & Format(s2.Range("j1").Value) & ".xlsm" 'Yedek = Yol & "Rapor.xlsm"
Dosya = Yol & Format(s2.Range("j1").Value) 'Dosya = Yol & "Rapor"

Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo + vbDefaultButton2, "Uyarı")
If Onay = vbYes Then
ThisWorkbook.Save
Mesaj = S1.Range("ı13").Value & "<br><br>" & S1.Range("ı14").Value & "<br><br>" & S1.Range("ı18").Value
'Mesaj = S1.Range("H13").Value & "<br><br>" & S1.Range("H25").Value & "<br><br>" & S1.Range("H28").Value
Mesaj = "<p style='color:black;font-family:Calibri (Gövde);font-size:14.5'>" & Mesaj & "</font></p>"
Call FSO.CopyFile(ThisWorkbook.FullName, Yedek, True)
Application.ScreenUpdating = False
Workbooks.Open Yedek, False, False


For Each Sayfa In ActiveWorkbook.Sheets
Sayfa.Select
Sayfa.Cells.Copy
Sayfa.Cells.PasteSpecial xlValues
Range("A1").Select
Next

Sheets(1).Select
Application.DisplayAlerts = False

Range("A1").Select
'Yeni
Sheets("yazma").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Data_mail").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Data_Tezgah").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Kayıtlar").Select
ActiveWindow.SelectedSheets.Delete
'ActiveWorkbook.Save
'yeni
ActiveWorkbook.SaveAs Dosya, 51, Local:=True
ActiveWorkbook.Close 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True

With Yeni_Mail
.Display
.To = S1.Range("ı4").Value
.CC = S1.Range("ı7").Value
.BCC = ""
.Subject = S1.Range("ı10").Value
.HTMLBody = Mesaj & .HTMLBody
.Attachments.Add Dosya & ".xlsx"
.BodyFormat = 2
.Save
'.Send

End With
Kill Dosya & ".xlsx"
Kill Yedek

MsgBox "İşleminiz tamamlanmıştır.", vbInformation

'Kayıtlar Kayıt yapma

Kayitlar

'sıra artırma
Sheets("yazma").Select
Range("D1").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
MsgBox "İşleminiz iptal edilmiştir.", vbInformation
End If

Set S1 = Nothing
Set Yeni_Mail = Nothing
Set Uygulama = Nothing
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")

ActiveSheet.Pprotect "knk963"
Range("C6").Select
ActiveWorkbook.Save
End Sub

 

[incsoft]

Sayfa.Cells.PasteSpecial xlValues kısmında hata veriyor

 

[Tevfik_Kursun]

Merhaba,
ActiveSheet.Pprotect "knk963" bu satır sizin 2. satırınız, ActiveSheet.Unprotect "knk963" olacak (bu şifreyi kaldırır)
ActiveSheet.Pprotect "knk963" bu satır sondan 4.satırınız, bu da ActiveSheet.Protect "knk963" olacak (bu şifreyi koyar)
2. mesajda ben yanlışlıkla ActiveSheet.Pprotect "şifreniz" yazmışım. Bu yanlış.
İyi çalışmalar