• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aynı Sayfada İki Private Sub Makrosu

Katılım
16 Ekim 2007
Mesajlar
143
Excel Vers. ve Dili
EXCEL 2003 TR
Arkadaşlar, kod yazmayı bilmediğim için ihtiyacım olan kodları forumdan buluyorum. Aynı sayfada iki tane Private sub makrosu olduğundan kodlar çalışmıyor. Kodlar aşağıda veriyorum. İlginiz ve yardımlarınız için şimdiden teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range) 'Otomatik Sıralama Makrosu
On Error Resume Next
If Intersect(Target, [k3:k65536]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
Selection.Sort Key1:=Range("a3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Target.Offset(1, -10).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
Set S2 = Sheets("Kontrol")
If Target <> "" Then
S2.[A4] = Target
S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
End If
Set S2 = Nothing
End Sub
 
Bir koddaki private sub ve end sub satırlarını almadan diğerinin içine kopyalayarak dener misiniz lütfen.
 
&#199;al&#305;&#351;ma sayfan&#305;zda ne yapmak istiyorsunuz , onu s&#246;ylerseniz yard&#305;mc&#305; olabilirim belki.
 
Private Sub Worksheet_Change(ByVal Target As Range) 'Otomatik Sıralama Makrosu
On Error Resume Next
If Intersect(Target, [k3:k65536]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
Selection.Sort Key1:=Range("a3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Target.Offset(1, -10).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
Set S2 = Sheets("Kontrol")
If Target <> "" Then
S2.[A4] = Target
S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
End If
Set S2 = Nothing
End Sub

1.Kod: Bulunduğu sayfanın k sütununda enter yapıldığında a sütununa göre A3 hücresinden başlayarak sıralatıyor.
2.Kod: Bulunduğu sayfanın A3 hücresine değer girildiğinde bu hücredeki tarihi önce "Kontrol" sayfasının A4 hücresine kopyalıyor, sonrada buradanda sütun sonuna kadar(A65536) sıralatıyor.
 
Say&#305;n akhsahbaz,

A&#351;a&#287;&#305;daki &#351;ekilde bir dener misiniz ?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [k3:k65536]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
Selection.Sort Key1:=Range("a3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
Set S2 = Sheets("Kontrol")
If Target <> "" Then
S2.[A4] = Target
S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
End If
Set S2 = Nothing
End Sub
 
Kod:
Private Sub Worksheet_Change(ByVal Target As Range) 'Otomatik S&#305;ralama Makrosu
On Error Resume Next
If Intersect(Target, [A3:A65536,k3:k65536]) Is Nothing Then Exit Sub

if target.coloumn = 11 then 
If Target.Value = "" Then Exit Sub
Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
Selection.Sort Key1:=Range("a3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Target.Offset(1, -10).Select

elseif target.coloumn = 1 then 

'____________
Set S2 = Sheets("Kontrol")
If Target <> "" Then
S2.[A4] = Target
S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
End If
end if
Set S2 = Nothing
End Sub

olarak denermisiniz ben denemedim ama mant&#305;k bu &#351;ekilde
 
Son düzenleme:
Sn.Sertkaya ve Sn.hsayar ilginiz i&#231;in te&#351;ekk&#252;r ederim. Her iki kod da malesef olmad&#305;. Sn.hsayar &#305;n ilk End Sub da hata veriyor.
 
ilk end subu silin benim g&#246;z&#252;mden ka&#231;m&#305;&#351; oda olmazsa dosyay&#305; ekleyiniz
 
Silincede kod malesef &#231;al&#305;&#351;m&#305;yor Sn.hsayar.
 
Say&#305;n akhsahbaz,

Dosyan&#305;z &#246;zel de&#287;il ise ekler misiniz.
 
Dosyayı yeniden düzenleyip konuyu anlatmaya çalıştım.
 
Son düzenleme:
&#304;yi de Say&#305;n akhsahbaz,

Sizin bu kodlar&#305;n&#305;z&#305;n oldu&#287;u b&#246;l&#252;m neresi ? Ben mi g&#246;remiyorum ???

Dosyay&#305; buraya ekledi&#287;iniz haliyle bende normal a&#231;&#305;l&#305;yor ve hi&#231;bir hata vermiyor. Zira bahsetti&#287;iniz sayfa kodlar&#305; yok. Hata veren b&#246;l&#252;m&#252; eklemelisiniz ki oray&#305; d&#252;zeltelim.
 
Bunu deneyin.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

    If Intersect(Target, [k3:k65536]) Then
        If Target.Value = "" Then Exit Sub
        Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
        Selection.Sort Key1:=Range("a3"), _
            Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        Target.Offset(1, -10).Select
    
    ElseIf Target.Address = "$A$3" Then
        Set S2 = Sheets("Kontrol")
        If Target.Value <> "" Then
            S2.[A4] = Target.Value
            S2.[A4].AutoFill Destination:=S2.[A4:A65536], _
                Type:=xlFillDays
        End If
        Set S2 = Nothing
    End If
    
End Sub
 
Sn.Sertkaya, ben o kodlar&#305;da birlikte oldu&#287;u zaman &#231;al&#305;&#351;mad&#305;&#287;&#305; i&#231;in silmi&#351;tim. Kodlar 1.sayfada yani "Form" adl&#305; sayfada duruyorlard&#305;.
Buarada Sn.anemos ilginiz i&#231;in te&#351;ekk&#252;r ederim ama bu kodda &#231;al&#305;&#351;m&#305;yor.
 
Say&#305;n akhsahbaz,

Private Sub Worksheet_Change(ByVal Target As Range) 'Otomatik S&#305;ralama Makrosu
On Error Resume Next
If Intersect(Target, [k3:k65536]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Range(Cells(3, "a"), Cells(Target.Row, "k")).Select
Selection.Sort Key1:=Range("a3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Target.Offset(1, -10).Select
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
Set S2 = Sheets("Kontrol")
If Target <> "" Then
S2.[A4] = Target
S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
End If
Set S2 = Nothing
End Sub

Kodlar&#305; aynen bu &#351;ekilde denedim ve hi&#231; bir hata vermedi.
Not : Kodlar&#305;n (ilk mesajda yazd&#305;&#287;&#305; halde) Form sayfas&#305;nda oldu&#287;unu bir anl&#305;k d&#252;&#351;&#252;nemeden mesaj yazd&#305;&#287;&#305;m i&#231;in kusura bakmay&#305;n.
 
1.Kod: Bulundu&#287;u sayfan&#305;n k s&#252;tununda enter yap&#305;ld&#305;&#287;&#305;nda a s&#252;tununa g&#246;re A3 h&#252;cresinden ba&#351;layarak s&#305;ralat&#305;yor.

2.Kod: Bulundu&#287;u sayfan&#305;n A3 h&#252;cresine de&#287;er girildi&#287;inde bu h&#252;credeki tarihi &#246;nce "Kontrol" sayfas&#305;n&#305;n A4 h&#252;cresine kopyal&#305;yor, sonrada buradanda s&#252;tun sonuna kadar(A65536) s&#305;ralat&#305;yor.

benim verdi&#287;im kodlarda bu i&#351;i yap&#305;yor ama sayfa2 ye kopyalam&#305;yor &#231;&#252;nk&#252; bu kod sat&#305;r&#305; (.copy i&#231;eren sat&#305;r) yok.

siz amac&#305;n&#305;z tam olarak tekrar izah ediniz ona g&#246;re yeni bir &#231;&#246;z&#252;m denensin.
 
Sn.Sertkaya ben kodu denedim bende &#231;al&#305;&#351;m&#305;yor. E&#287;er zahmet olmazsa bana kodu &#231;al&#305;&#351;t&#305;rm&#305;&#351; oldu&#287;unuz &#231;al&#305;&#351;may&#305; g&#246;nderirseniz sevinirim.
 
Sayın akhsahbaz,

Ben öncelikle sizde ne tür bir hataya sebep olduğunu sorarak, dosyayı ekleyeyim.

Ben sadece açılışta direkt hata mesajı aldığınızı varsayarak hata yok dedim. Eğer Sayın hsayar'ın dediği gibi kopyalama vs. işlemini yapmıyorsa kodları o kadar detaylı incelemediğimi belirtmek isterim.
 
Sn.hsayar,

1.Kod: Bulundu&#287;u sayfan&#305;n k s&#252;tununda herhangi bir h&#252;creye enter yap&#305;ld&#305;&#287;&#305;nda a s&#252;tunundaki tarihler k&#252;&#231;&#252;kten b&#252;y&#252;&#287;e do&#287;ru A3 h&#252;cresinden ba&#351;layarak s&#305;ralat&#305;yor.(Kod Enter ile &#231;al&#305;&#351;&#305;yor)

2.Kod: Bulundu&#287;u sayfan&#305;n("Form") A3 h&#252;cresine de&#287;er(tarih) girildi&#287;inde bu h&#252;credeki tarihi &#246;nce "Kontrol" sayfas&#305;n&#305;n A4 h&#252;cresine kopyal&#305;yor, sonrada "Kontrol" sayfas&#305; A4 h&#252;cresindeki tarihden otomatik olarak s&#252;tunun sonuna kadar(A65536) tarih s&#305;ralat&#305;yor. (Kod "Form" sayfas&#305;n&#305;n A3 H&#252;cresine de&#287;er girilmesi ile &#231;al&#305;&#351;&#305;yor)
 
Geri
Üst