Dosya çökmesi

[excellkurdu]

Hayırlı günler dilerim Arkadaşlar,
Aşağıdaki kodda Sayfa19.Cells(7, 3) = deger bunu ekleyince excel sayfam çöküyor. Bellek yetersizliği hatası veriyor. Sayfa sutunları bozuluyor.
Yardımcı olursanız sevinrim.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deger As String
On Error GoTo Hata
If Cells(Target.Row, 3) <> "" Then
deger = Application.WorksheetFunction.VLookup([C4], Sayfa2.Range("B4:D12"), 2, False)
ActiveSheet.Range("c6").Select
Sayfa19.Cells(7, 3) = deger
End If
Hata:
End Sub

 

[dEdE]

Dener misiniz?
Sizin kodunuzun çökmeyi önleyecek şekilde düzenlenmiş hali.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deger As String
On Error GoTo Hata
Application.EnableEvents = False
    If Cells(Target.Row, 3) <> "" Then
        deger = Application.WorksheetFunction.VLookup([C4], Sayfa2.Range("B4:D12"), 2, False)
        Sayfa19.Cells(9, 3) = deger
    End If
Application.EnableEvents = True
Hata:
End Sub

Kod, C sütunundaki tüm hücreler için çalışıyor. Buna gerek yok. C4 hücresi değişince kod çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deger As String
If Not Intersect(Target, Range("C4")) Is Nothing Then
    If Cells(Target.Row, 3) <> "" Then
        Sayfa19.Cells(9, 3) = Application.WorksheetFunction.VLookup([C4], Sayfa2.Range("B4:D12"), 2, False)
    End If
End If
End Sub

 

[excellkurdu]

Dener misiniz?
Sizin kodunuzun çökmeyi önleyecek şekilde düzenlenmiş hali.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deger As String
On Error GoTo Hata
Application.EnableEvents = False
    If Cells(Target.Row, 3) <> "" Then
        deger = Application.WorksheetFunction.VLookup([C4], Sayfa2.Range("B4:D12"), 2, False)
        Sayfa19.Cells(9, 3) = deger
    End If
Application.EnableEvents = True
Hata:
End Sub

Kod, C sütunundaki tüm hücreler için çalışıyor. Buna gerek yok. C4 hücresi değişince kod çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deger As String
If Not Intersect(Target, Range("C4")) Is Nothing Then
    Application.EnableEvents = False
        If Cells(Target.Row, 3) <> "" Then
            Sayfa19.Cells(9, 3) = Application.WorksheetFunction.VLookup([C4], Sayfa2.Range("B4:D12"), 2, False)
        End If
    Application.EnableEvents = True
End If
End Sub

Hocam Çok tşk ederim. Gayet güzel oldu. Halaa deneme aşamasındayım. Kod bazen çalışmıyor. dosyayı kapatıp açınca çalışıyor bazen yine duruyor. Sebebini bulmaya çalışıyorum. son gönderdiğiniz kodu da deniyeceğim.

 

[excellkurdu]

Sayın Hocam 2. kod stabil çalıştı. Sanırım sorun Sizin dediğiniz gibi C sutununu kapsayan kodlar yüzünden di.
Çok sağolun