koşullu makro

[xp45s]

merhaba;
Ekteki dosyayı siteden bulup kendime göre uyarladım fakat macrolar istedigim gibi çalışmıyor.Yardımlarınızı bekliyorum.Gerekli açıklamalar net bir şekilde dosyanın içinde mevcuttur.

 

[xp45s]

yardım edebilecek kimse yokmu acaba

 

[leumruk]

Merhaba,
Dosyanızdaki kodu aşağıdakiyle değiştirin.

Sub dagit()
Dim k As Range, i As Long, sat As Long
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("AI2:ED65536").Clear
son = Cells(65536, "A").End(xlUp).Row
For i = 2 To son
    For j = 3 To 31
        If Cells(i, j).Value <> "" Then
            Set k = Range("AI1:ED1").Find(Cells(i, j).Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
            sat = Cells(65536, k.Column).End(xlUp).Row + 1
            Cells(sat, k.Column).Value = Cells(i, "A").Value
            End If
        End If
    Next
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[xp45s]

ilginiz ve yardımınız için teşekkür ederim..