aşağıda eklediğim dosyalarda pol dosyasında gecici görev dosyasınafarklı sutunlara veri aktarmak istiyorum fakat beceremedim bilgisi olanlar yardım edebilirmi
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"’’E’’)) 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
With wb.Worksheets("Sayfa1").Cells(satBul, "C")
.Value = "SIRINTEPE"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -6).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub
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"’’E’’)) 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
With wb.Worksheets("Sayfa1").Cells(satBul, "C")
.Value = "SIRINTEPE"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -6).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub