Belirli hücreleri değiştirme

[excellkurdu]

Merhaba Arkadaşlar,
"J sütunundaki puanlamaları değiştirip "J - SÜTUNUNU YENİDEN GÖNDER" e basınca, Denetim sayfadaki I2 deki tarihi, Datadenetim sayfasındaki, C sütununda bulmalı, Datadenetim sayfasındaki ilgili tarihi bulunca puanları, Datadenetim sayfasının BMI dan BTN ya kadar tüm satırı yeniden değiştirmeli
Bunu yaparken Datadenetim sayfasındaki A dan BMH ye kadar olan veriye dokunulmayacak, aynen kalacak. Umarım anlatabilmişimdir.
Şimdiden teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodlar işinizi görür mü acaba:

Sub gönder()
Sheets("denetim").Range("J6:J193").Copy
Sheets("datadenetim").Select
a = Sheets("denetim").[I2]
For i = 6 To Sheets("datadenetim").[a65536].End(xlUp).Row
If Sheets("datadenetim").Cells(i, "c") = a Then
Cells(i, "c").Select
Sheets("datadenetim").Cells(i, "BMI").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Application.CutCopyMode = False

End If
Next
End Sub

 

[excellkurdu]

Hocam denedim şifresiz ve korumasız dosyada çalışıyor. teşekkür ederim.
Fakat bir sorun ile karşılaştım. datadenetim sayfam gizli ve bazı hücreler korumalı. Bir sayfadan diğer sayfaya geçerken otomatik korumalı oluyor. ActiveSheet.Unprotect "****" Koruma şifresini girince sorun çözülmüyor, çünkü kopya iptal oluyor, yapıştırmıyor. Bunu nasıl aşabiliriz?

Aşağıdaki kodlar işinizi görür mü acaba:

Sub gönder()
Sheets("denetim").Range("J6:J193").Copy
Sheets("datadenetim").Select
a = Sheets("denetim").[I2]
For i = 6 To Sheets("datadenetim").[a65536].End(xlUp).Row
If Sheets("datadenetim").Cells(i, "c") = a Then
Cells(i, "c").Select
Sheets("datadenetim").Cells(i, "BMI").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Application.CutCopyMode = False

End If
Next
End Sub

 

[excellkurdu]

ThisWorkbook sayfasında şu kod var;
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Sayfaların elle yada otomatik hesaplanması; diğer sayfalar için buraya yazdım

Dim nesne As Shape
ActiveSheet.Unprotect "****"

On Error Resume Next
Set nesne = ActiveSheet.Shapes("1 Dikdörtgen")

If Application.Calculation = xlManual = True Then
nesne.TextFrame.Characters.Text = "EL İLE"
Else
nesne.TextFrame.Characters.Text = "OTOMATİK"
End If
ActiveSheet.Protect "****"
End Sub

Bu kodu silince sorun çözülüyor ama bunu silince sayfalardaki hesaplamalar istem dışı kalıyor.

 

[YUSUF44]

VErdiğiniz örnek dosya ve önce sorduğunuza göre doğru cevabı verdiğimi düşünüyorum. Örnek dosyanızın asıl dosyanızdan farklı olması bu forum açısından "iyi bir şey değildir".

İki farklı makro kodu çakışınca nasıl olur bilmiyorum. Zaten yeni yeni makro düzenlemeye başladım, onlar da bu forumdan öğrendiğim şeyler. Aklıma ilk gelen benim makroda diğer sayfaya geçildiği yere (sheets("datadenetim").select satırından sonra) activesheet unprotect diye satır eklemek. ancak bu durumda sayfa etkinleştirmeye bağlı kilitleme makrosuyla çakışma olur.