otomatik silme ve doldurma

[Erdem Akdemir]

Arkadaşlar merhaba

Ekteki soruda b sütünuna veri girdiğim zaman a ve c sütununa belirttiğim koşullara göre değerler atıyor

benim istediğim b sütunundaki verileri sildiğim zaman a ve c'deki verilerde silinsin

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo son
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
For i = 1 To [b1000].End(3).Row
Cells(i, 1) = Cells(i, 1).Row
Cells(i, 3) = "TÜRKİYE"
Next i
son:
Application.ScreenUpdating = True
End Sub

 

[Evolver]

aşağıdaki kodları deneyip sonucu bildirirmisiniz

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target.Value <> "" Then
        Cells(Target.Row, 1).Value = Target.Row
        Cells(Target.Row, 3).Value = "Türkiye"
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
End Sub

 

[Erdem Akdemir]

aşağıdaki kodları deneyip sonucu bildirirmisiniz

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target.Value <> "" Then
        Cells(Target.Row, 1).Value = Target.Row
        Cells(Target.Row, 3).Value = "Türkiye"
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
End Sub

üstad eline sağlık

 

[Evolver]

sizinde
iyi çalışmalar

 

[Erdem Akdemir]

kopyala, yapıştır dediğim zaman çalışmıyor

 

[Evolver]

gerçekten çok ilginç çünkü ben kopyala yapıştır yaparak denedim herhangi bir sorun yok yine çalıştı

 

[Evolver]

sanırım kopyala-yapıştır derken neyi kastettiğinizi anladım.
birden çok hücreye aynı anda kopyalamak istediğinizde hata veriyordu
bu sorunu aşmak için kodlarınızı aşağıdakilerle değiştirin

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target.Count > 1 Then
        For i = 1 To Target.Count
            If Selection(i, 1).Value <> "" Then
                Selection(i, 1).Offset(0, -1).Value = Selection(i, 1).Row
                Selection(i, 1).Offset(0, 1).Value = "Türkiye"
            Else
                Selection(i, 1).Offset(0, -1).Value = ""
                Selection(i, 1).Offset(0, 1).Value = ""
            End If
        Next i
    ElseIf Target.Value <> "" Then
        Cells(Target.Row, 1).Value = Target.Row
        Cells(Target.Row, 3).Value = "Türkiye"
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
End Sub

 

[Erdem Akdemir]

sayın evolver şimdi istediğim gibi oldu, elinize sağlık

 

[Evolver]

söylemek istediğinizi geç anladım kusura bakmayın
iyi günler