kodları butona atayacak şekilde nasıl düzenleyebiliriz

[numan şamil]

Merhabalar
Forumda bulduğum aşağıdaki kodları buton ile çalıştırmak için kodları nasıl düzenleyebiliriz
Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range, Sa As Worksheet, ilkadres As Variant

Set Sa = Sheets("ALACAK")

If Intersect(Target, Range("D5" & Rows.Count)) Is Nothing Then Exit Sub
Target.Offset(0, 1).ClearContents

With Sa.Range("B4:B" & Rows.Count)
Set c = .Find(Target.Offset(0, -2), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
With Target
If bHarf(Sa.Range("C" & c.Row)) = bHarf(.Offset(0, -1)) And _
bHarf(Sa.Range("D" & c.Row)) = bHarf(.Value) Then
.Offset(0, 1) = Sa.Range("E" & c.Row)
End If
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
End Sub

Function bHarf(Veri As String)
bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

 

[hamitcan]

Target kelimesi yerine sheets("sayfa ismi").activecell satırını koyurak deneyin.
Başlık kısmını da Private Sub Worksheet_Change(ByVal Target As Range)
Sub deneme() şeklinde değiştirin.

 

[numan şamil]

Target kelimesi yerine sheets("sayfa ismi").activecell satırını koyurak deneyin.
Başlık kısmını da Private Sub Worksheet_Change(ByVal Target As Range)
Sub deneme() şeklinde değiştirin.

Merhaba Hamitcan Hocam
If bHarf(Sa.Range("C" & c.Row)) = bHarf(.Offset(0, -1)) And _ kısmı hata verdi
yapamadım
If Intersect(Target, Range("D5" & Rows.Count)) Is Nothing Then Exit Sub
Target.Offset(0, 1).ClearContents
kısmı nasıl olacak
Function bHarf(Veri As String)
bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function her hangi birdeğişiklik olacakmı?
Mümkünse kodları düzenleyebilirmisiniz

 

[numan şamil]

Merhaba arkadaşlar
1. nolu mesajımdaki ekli dosyadaki kodları bir düğmeye atamak istedim
Aşağıdaki gibi kodları düzenledim
Fakat yapamadım yardımcı olabilirmisiniz
Sub işlemyap()
'Private Sub Worksheet_Change(ByVal Target As Range)' iptal
Dim c As Range, Sa As Worksheet, ilkadres As Variant

Set Sa = Sheets("ALACAK")

If Sheets("GELİR").Range("D5" & Rows.Count) Is Nothing Then Exit Sub
Sheets("GELİR").Range("C5:K10").ClearContents

With Sa.Range("B4:B" & Rows.Count)
Set c = .Find(Sheets("GELİR").ActiveCell.Offset(0, -1), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
With Sheets("GELİR").ActiveCell 'Target
If bHarf(Sa.Range("C" & c.Row)) = bHarf(.Offset(0, -1)) And _
bHarf(Sa.Range("D" & c.Row)) = bHarf(.Value) Then
.Offset(0, 1) = Sa.Range("E" & c.Row)
End If
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
End Sub

Function bHarf(Veri As String)
bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

 

[numan şamil]

Dosya eklendi
hata mesajı alıyorum
neden acaba?

 

[Ömer]

Merhaba,

Eski kodları göz önüne bulundurmadan yapmak istediğinizi açıklarsanız sonuca daha kolay ulaşırız.

 

[numan şamil]

Merhaba,

Eski kodları göz önüne bulundurmadan yapmak istediğinizi açıklarsanız sonuca daha kolay ulaşırız.

Merhaba Ömer bey
Bir önceki mesajımda dosya eklememişim kusura bakmayın
üç sutundaki verilere göre "alacak" sayfasından gelir sayfasına makro ile veri getirmek istiyorum
Yani Eğer "GELİR" sayfasındaki B-C-D sutunlarındaki veriler ile "ALACAK" sayfasındaki B-C-D sutundaki veriler birebir eşleşirse buna denk gelen "ALACAK" sayfasındaki E sutununadaki verileri "GELİR " sayfasının E sutununa getir.Şeklinde
Ekli dosyada sarı boyalı E sutununa gelmesi gereken veriler manuel yazıldı

 

[numan şamil]

Arkadaşlar
1 Nolu mesajımdaki kodları bir butona atanacak şekilde dizayn edilmesi veya 7.nolu mesajdaki ekli dosyada istediklerimi yapacak birmakro yazımı için yardımlarınızı bekliyorum

 

[Ömer]

Arkadaşlar
1 Nolu mesajımdaki kodları bir butona atanacak şekilde dizayn edilmesi veya 7.nolu mesajdaki ekli dosyada istediklerimi yapacak birmakro yazımı için yardımlarınızı bekliyorum

Bu şekilde deneyin.

Sub VeriAl()
 
    Dim c As Range, Sa As Worksheet, ilkadres As Variant, i As Long
     
    Set Sa = Sheets("ALACAK")
    
    Application.ScreenUpdating = False
    Sheets("GELİR").Select
    Range("E5:E" & Rows.Count).ClearContents
    
    For i = 5 To Cells(Rows.Count, "D").End(xlUp).Row
        With Sa.Range("D4:D" & Rows.Count)
            Set c = .Find(Cells(i, "D"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                ilkadres = c.Address
                Do
                    If Sa.Cells(c.Row, "B") = Cells(i, "B") And _
                        bHarf(Sa.Cells(c.Row, "C")) = bHarf(Cells(i, "C")) Then
                        Cells(i, "E") = Sa.Cells(c.Row, "E")
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> ilkadres
            End If
        End With
    Next i
    
End Sub
 
Function bHarf(Veri As String)
    bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

.

 

[numan şamil]

Çok teşekkür ederim ömer bey