DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Dim stn%, sat%, y%, i%
On Error GoTo HataYakala
If Target.Column = 2 And Target.Row > 8 Then
Range(Cells(Target.Row, 4), Cells(Target.Row + 1, 10)).ClearContents
If InStr(1, Target, "-", vbTextCompare) > 0 Then
With Sheets("Sayfa1")
Set rg = .Columns(1).Find(Left(Target, InStr(1, Target, "-", vbTextCompare) - 1), Lookat:=xlWhole)
If Not rg Is Nothing Then
y = 4
Application.EnableEvents = False
Cells(Target.Row, 1) = Application.WorksheetFunction.Max(Range("A9:A500")) + 1
For i = 3 To 16 Step 2
Cells(Target.Row, y) = .Cells(rg.Row, i)
Cells(Target.Row + 1, y) = .Cells(rg.Row, i + 1)
y = y + 1
Next i
Application.EnableEvents = True
Set rg = Nothing
End If
End With
End If
End If
Exit Sub
HataYakala:
Application.EnableEvents = True
End Sub