bulunan değeri silme

[musmus]

Arkadaşlar merhaba,
sizlerden ricam sayfa 1'de sıra numarası vererek listelediğim değerleri, sayfa2'ye düşeyara ile getirmek ve en önemlisi bulunan değeri sayfa1'den silmek. Yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Siz zaten formülle verileri diğer sayfaya aktarmışsınız. Geriye sadece silmek kalmış. Fakat işin içine silme girdiği için işlemi makro ile yapmanız gerekiyor.

Aşağıdaki kod "Sayfa2" "B" sütunundaki verileri "Sayfa1" de arar. Bulduğu bilgiyi "Sayfa2" ye aktarır ve "Sayfa1" den ilgili satırı tamamen siler.

Option Explicit
 
Sub BUL_AKTAR_SİL()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, BUL As Range
    
    Set S1 = Sheets("sayfa1")
    Set S2 = Sheets("sayfa2")
    
    For X = 2 To S2.Range("B65536").End(3).Row
        Set BUL = S1.Cells.Find(S2.Cells(X, 2), , , xlWhole)
        If Not BUL Is Nothing Then
            S2.Cells(X, 1) = BUL.Offset(0, 1)
            BUL.EntireRow.Delete
        End If
    Next
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[İhsan Tank]

Arkadaşlar merhaba,
sizlerden ricam sayfa 1'de sıra numarası vererek listelediğim değerleri, sayfa2'ye düşeyara ile getirmek ve en önemlisi bulunan değeri sayfa1'den silmek. Yardımlarınızı bekliyorum.

bir alternatif olsun

Option Explicit
Sub bul_sil()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Verilerin Karşılığını Bulup Siliyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
For ts = 2 To Sheets("sayfa2").Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("A2:A65536"), Sheets("sayfa2").Range("B" & ts)) > 0 Then
Sheets("sayfa2").Cells(ts, "A") = WorksheetFunction.VLookup(Sheets("sayfa2").Range("B" & ts), _
Sheets("sayfa1").Range("A2:B65536"), 2, 0)
End If
Next
For kaplan = Sheets("sayfa1").Cells(65536, "A").End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(Sheets("sayfa2").Range("B2:B65536"), Sheets("sayfa1").Range("A" & kaplan)) > 0 Then
Sheets("sayfa1").Cells(kaplan, "C") = 1
End If
If Sheets("sayfa1").Range("C" & kaplan) = 1 Then
Range("A" & kaplan & ":C" & kaplan).Delete
End If
Next
MsgBox "Veriler'i Buldum ve Sildim", vbInformation, "Bitiş"
End Sub

 

[musmus]

Arkadaşlar yardımlarınız için çok teşekkür ederim (teşekkür için biraz geç kaldım kusura bakmayın)
verdiğiniz makroları denedim ve çalıştırdım. Ellerinize sağlık.