Makronun Belirli Sayfaların Dışında Diğer Sayfalarda Çalışması

[itouchcanmedia]

Arkadaşlar aşağıdaki kod çalışma kitabındaki bir sayfanın ("faturalar" isimli sayfanın) kod bölümünde bulunuyor ve sadece kodun içerisinde de göreceğiniz gibi kodda yazılı olan "kontrol(1)", "kontrol(2)", "kontrol(3)" isimli sayfalarda gerekli hesaplamaları yapıyor ve işini yapıyor ancak ben bu kodun şu şekilde değişmesini arzuluyorum. Şöyleki; Ben yine kod'u "faturalar" isimli sayfanın kod bölümüne yapıştıracağım ancak çalışma kitabındaki benim belirleyeceğim, örneğin "demirbaşlar" ve "makbuzlar" sayfaları dışındaki bütün sayfalarda çalışmasını istiyorum. Gerekli düzenlemeyi bir türlü yapamadım. Yardımlarınızı bekliyorum.Çok ama çok mutlu olurum. Saygılarımla...








Private Sub Worksheet_Change(ByVal Target As Range)
MxRw = Application.Max(Range("A2").End(xlDown).Row, Range("D2").End(xlDown).Row, Range("F2").End(xlDown).Row)
If Intersect(Target, Range("A2:G" & MxRw)) Is Nothing Then Exit Sub
Dim twn As Boolean, blnk As Boolean
Application.Calculation = xlCalculationManual
colmn = Array(Empty, 3, 5, 7)
For col = Val(Mid(1112233, Target.Column, 1)) To Val(Mid(1112233, Target.Column + Target.Columns.Count - 1, 1))
Select Case colmn(col)
Case 3
cl = 1: ara = "F:F": veri = Array(2, 3): yaz = Array(17, 18): twn = True
Case 5
cl = 4: ara = "A:A": veri = 5: yaz = 16: twn = False
Case 7
cl = 6: ara = "E:E": veri = 7: yaz = 19: twn = False
End Select
For Rw = Target.Row To Target.Row + Target.Rows.Count - 1
Src = Cells(Rw, cl)
If twn Then blnk = Not IsEmpty(Cells(Rw, cl + 1)) And Not IsEmpty(Cells(Rw, cl + 2)) Else blnk = Not IsEmpty(Cells(Rw, cl + 1))
If IsEmpty(Src) Or Not blnk Then GoTo ex
For Each syf In Array("kontrol(1)", "kontrol(2)", "kontrol(3)")
With Sheets(syf)
Set Rng = .Range(ara).Find(Src, , xlValues, xlWhole)
If Rng Is Nothing Then
CreateObject("WScript.Shell").PopUp Cells(1, cl) & " " & Src & " verisi " & _
.Name & " Sayfasında bulunamadı.", 1, "Bilgi", vbOKOnly
Else
adr = Rng.Address
Do
If IsArray(veri) Then
For n = 0 To UBound(veri)
.Cells(Rng.Row, yaz) = Cells(Rw, veri)
Next
Else
.Cells(Rng.Row, yaz) = Cells(Rw, veri)
End If
Set Rng = .Range(ara).FindNext(Rng)
Loop While Not Rng Is Nothing And Not Rng.Address Like adr
End If
End With
Next syf
ex: Next Rw
Next col
Application.Calculation = xlCalculationAutomatic
End Sub

 

[ÖmerBey]

Merhaba,
Döngüyü aşağıdaki şekilde değiştirip deneyiniz...

For Each syf In Sheets
    If syf.Name <> "demirbaşlar" And syf.Name <> "makbuzlar" Then
        With syf
            Set Rng = .Range(ara).Find(Src, , xlValues, xlWhole)
            If Rng Is Nothing Then
                CreateObject("WScript.Shell").PopUp Cells(1, cl) & " " & Src & " verisi " & _
                .Name & " Sayfasında bulunamadı.", 1, "Bilgi", vbOKOnly
            Else
                adr = Rng.Address
                Do
                    If IsArray(veri) Then
                        For n = 0 To UBound(veri)
                            .Cells(Rng.Row, yaz(n)) = Cells(Rw, veri(n))
                        Next
                    Else
                        .Cells(Rng.Row, yaz) = Cells(Rw, veri)
                    End If
                    Set Rng = .Range(ara).FindNext(Rng)
                Loop While Not Rng Is Nothing And Not Rng.Address Like adr
            End If
        End With
    End If
Next syf

 

[itouchcanmedia]

Ömer bey ne kadar teşekkür etsem az. öyle güzel olduki... çok ama çok sağolun...

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar diliyorum...