Sub Whatsap_ekle_sil_guncelle()



Dim syfAna As Worksheet, hatalimi As Boolean

Dim baglan As Object, rs As Object



Set baglan = CreateObject("adodb.connection")

Set rs = CreateObject("adodb.recordset")



Set syfAna = ThisWorkbook.Worksheets("Ana_Sayfa")



Application.ScreenUpdating = False

sonAna = syfAna.Range("A:A").Find("*", , , , , xlPrevious).Row

hatalimi = False





With ThisWorkbook.Worksheets("WHATSAPP")

  .Unprotect "171717"

    .Range("A2:A" & Rows.Count).ClearContents

    

    If sonAna < 2 Then

        hatalimi = True: GoTo son

    End If



    kac = WorksheetFunction.CountA(syfAna.Range("A2:A" & Rows.Count))

    If kac = 1 Then

        .Range("A2").Value = syfAna.Cells(sonAna, "AD").Value

        GoTo son

    End If

    

  baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _

    ";extended properties=""excel 12.0;hdr=yes"""

      rs.Open "select [WHATSAPP NO] from [Ana_Sayfa$] where [WHATSAPP NO]<>' '", baglan, 1, 1

      If rs.RecordCount > 0 Then .Range("A2").CopyFromRecordset rs

son:

Application.ScreenUpdating = True

.Protect "171717"

End With

On Error Resume Next

If hatalimi = True Then

    MsgBox "Kaydedilecek yada güncellenecek yada silinecek veri yok.", vbCritical, "Hata"

Else

    MsgBox "islem tamam.", vbInformation, "Bilgi"

End If

Set sic = Nothing: Set syfAna = Nothing: Erase arr: Erase dizi

rs.Close

baglan.Close

Set rs = Nothing

Set baglan = Nothing

End Sub