İlk boş hücreden itibaren yaz düzeltmesi

[Bora K]

Merhabalar.

Kırmızı ile belittiğim satırada.
B ve C sütununa veriler geliyor. Gelen veriler 4. satırdan
itibaren yazılmaya başlıyor. Eğer 4. satırda ve altındaki satırlarda
veriler var ise ilgili veriler siliniyor. (gelen veriler yine 4. satıra yazılıyor)

Ben eğer 4. satır ve alttaki satırlarda veriler var ise ilgili verilerin silinmesini
istemiyorum. Yeni gelen veriler en son boş hücreden itibaren yazılsın istiyorum.
Yardımlarınızı bekliyorum.
İyi akşamlar.

Sub AraYaz()
 
    Dim sat As Long, c As Range, Adr As String
 
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
   [COLOR="Red"] Range("B4:C" & Rows.Count).ClearContents[/COLOR]
 
    sat = 4
    With Sheets("Sayfa2")
        Set c = .[F:F].Find(Range("B2"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If .Cells(c.Row, "G") = Range("C2") Then
                    Cells(sat, "B") = .Cells(c.Row, "H")
                    Cells(sat, "C") = .Cells(c.Row, "I")
                    sat = sat + 1
                End If
                Set c = .[F:F].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub AraYaz()
 
    Dim sat As Long, c As Range, Adr As String
 
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
 
    sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
    If Range("B4") = "" Then sat = 4
    With Sheets("Sayfa2")
        Set c = .[F:F].Find(Range("B2"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If .Cells(c.Row, "G") = Range("C2") Then
                    Cells(sat, "B") = .Cells(c.Row, "H")
                    Cells(sat, "C") = .Cells(c.Row, "I")
                    sat = sat + 1
                End If
                Set c = .[F:F].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[Bora K]

Ömer Bey iyi akşamlar öncelikle.

Kodu yakın zamanda siz yazmıştınız. Sizi online göremeyince
ilgili başlıkta değilde, yeni konu ile yardım almak istedim.
Mazur görün lütfen.
Yardımınız için de çok çok teşekkür ederim.
Saygılarımla.