VBA kodunu değiştirme..

[Halit TÜRK]

Merhabalar..
Aşağıdaki kod ile B2 hücresine yazılan kelimelerle yeni sayfa açılıyor ve yeni sayfada vba kodunu siliyor. Benim isteğim ise yeni açılan sayfada silinen vba kodunun yerine sayfanın altında yazılan kodların yazılması... Yardımcı olabilirmisiniz... Teşekkürler...

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo hata
Set S1 = Sheets("FORM")
If Target.Address <> "$B$2" Then Exit Sub
If S1.[B2] <> "" Then
S1.COPY After:=Sheets(Worksheets.Count)
ActiveSheet.Name = S1.[B2].Value
ActiveSheet.[c10].Select
Dim YeniSayfa As Object
Set YeniSayfa = ThisWorkbook.VBProject.VBComponents(Sheets(Worksheets.Count).CodeName).CodeModule
YeniSayfa.DeleteLines 1, YeniSayfa.CountOfLines
S1.Select
'[A7].ClearContents
Target.Select
ActiveSheet.Next.Select
End If
[B2] = ClearContents
Exit Sub
hata:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
S1.Select
Target.Select
MsgBox "Ayn&#305; isimde sayfa mevcuttur." _
& Chr(10) & Chr(10) & "L&#252;tfen girdi&#287;iniz bilgileri kontrol ediniz.", vbExclamation, "Dikkat !"
Application.ScreenUpdating = True
End Sub

Yerine yaz&#305;lacak kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c10:c98]) Is Nothing Then Exit Sub
Target.Offset(0, 2) = Target * Target.Offset(0, 1)
Target.Offset(0, 6) = Target * Target.Offset(0, 5)
Target.Offset(0, 10) = Target * Target.Offset(0, 9)
Target.Offset(1, 0).Select
End Sub

 

[ECYavuz]

Denemedim ama ben bir başka şeklini kullanıyorum.

Kolay gelsin...

Sub AddProcedure()
Dim VBCodeMod, VBCode As CodeModule
Dim kod(17) As String
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("Sayfa7").CodeModule ' Buraya ilgili sayfayı siz değiştirin
With VBCodeMod
StartLine = .ProcStartLine("Worksheet_BeforeDoubleClick", vbext_pk_Proc)
HowManyLines = .ProcCountLines("Worksheet_BeforeDoubleClick", vbext_pk_Proc)
.DeleteLines StartLine, HowManyLines
End With
'Kod satırları
kod(1) = "Private Sub Worksheet_Change(ByVal Target As Range)"
kod(2) = "If Intersect(Target, [c10:c98]) Is Nothing Then Exit Sub"
kod(3) = "Target.Offset(0, 2) = Target * Target.Offset(0, 1)"
kod(4) = "Target.Offset(0, 6) = Target * Target.Offset(0, 5)"
kod(5) = "Target.Offset(0, 10) = Target * Target.Offset(0, 9)"
kod(6) = "Target.Offset(1, 0).Select"
kod(7) = "End Sub"
kod(8) = ""
j = 1
kodlar = ""
Do While kod(j) <> ""
kodlar = kod(j)
Set VBCode = ThisWorkbook.VBProject.VBComponents("Sayfa7").CodeModule ' Buraya ilgili sayfayı siz değiştirin
With VBCode
.InsertLines j, kodlar
End With
j = j + 1
Loop
End Sub

 

[Halit TÜRK]

Te&#351;ekk&#252;r ederim ama bu kodu uyarlamam zor olacak... Bu kadar bilgiye sahip de&#287;ilim..

 

[Halit TÜRK]

Say&#305;n ECYavuz,
Ba&#351;ka t&#252;rl&#252; bir &#231;&#246;z&#252;m olu&#351;turdum, a&#351;a&#287;&#305;daki kod ile ilgili bir olarak bir sorum olacak...
[c10:c98] k&#305;sm&#305;nda sat&#305;r eklendi&#287;inde veya sat&#305;r silindi&#287;inde 99, 100 veya 97, 96 &#351;eklinde de&#287;i&#351;me durumu m&#252;mk&#252;nm&#252;d&#252;r.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c10:c98]) Is Nothing Then Exit Sub
Target.Offset(0, 2) = Target * Target.Offset(0, 1)
Target.Offset(0, 6) = Target * Target.Offset(0, 5)
Target.Offset(0, 10) = Target * Target.Offset(0, 9)
Target.Offset(1, 0).Select