Karşılıklarını yazdırma

[eseseski]

eklediğim dosyalardan
pol dosyası çalışma kitabındaki aşağıdaki kodu geliştirerek
diğer sütunlarada uygulayıp geçici görev dosyasındaki karşılıklarına nasıl yazdırabilirim
bilgisi olanlar yardımcı olabilirmi acaba
ilgilenenler şimdiden teşekkürler.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim wb As Workbook
Dim satBul As Long
Dim comm As String

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub:

Set wb = Workbooks("geçici görev.xls")

On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("A"), 0)
If Err.Number = 0 Then
With wb.Worksheets("Sayfa1").Cells(satBul, "B")
.Value = "MGAZİ/SKAYA"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -5).Text
End With
Else
Exit Sub
End If
On Error GoTo 0

End Sub

 

[eseseski]

bilgisi olanlar yardım lütfen