Webden veri alırken yeni eklenen satırı nasıl tespit edebilirim

[birdhane]

Merhaba arkadaşlar, Excelde Veri sekmesi aracılığıyla webden veri çekiyorum ve veriyi dakikada bir yeniliyorum. Veri çektiğim tabloya yeni satır eklenince (yeni satır herhangi bir satırdan önce veya sonra eklenebiliyor, en son satır eklenmeyebiliyor yani) eklenen satırın A hücresindeki değeri mesaj kutusu olarak bildirecek VBA kodu lazım.
Worksheet_Change ile kontrol etmeye çalıştım ancak formülle veya kullanıcı tarafından giriş yapılmadığı için yeni satırın eklendiğini algılamıyor. Bu konuda yardımcı olabilecek arkadaş var mı acaba?

ÖRNEK DOSYA

 

[alicimri]

Veri aldığınız sayfada tablo dışında bir hücreye, tablo içindeki başka bir hücreyi referans gösteren formül yazın, örnek(=A1)
ThisWorkbook module de Private Sub Workbook_SheetCalculate(ByVal Sh As Object) olayını kullanarak kontrol için tetikleme yapabilirsiniz.

 

[excelokyanus500]

Birşeyler yapmaya çalıştım. Deneyin.
Dosya Örnek

 

[excelokyanus500]

Link silinirse bulunsun.

Sub MakroZamanPlanla()
    Const StartTime = "09:30"
    Const EndTime = "17:00"
    
    Dim RunTimer As Date
    RunTimer = Now + TimeValue("00:01:00") ' her 60 saniyede işlem yap.
    Application.OnTime RunTimer, "MakroZamanPlanla"

    If Time >= CDate(StartTime) And Time <= CDate(EndTime) Then
    
    Call TabloKarsilastirSon
    Sheets("KarsilastirmaSonuclari").Select
     On Error Resume Next
    ActiveSheet.ShowAllData
   Columns("A:A").AutoFilter
    ActiveSheet.Range("$A$1:$A$157800").AutoFilter Field:=1, Criteria1:=RGB(255, _
        0, 0), Operator:=xlFilterCellColor
    End If
End Sub



Sub MakroyuDurdur()
   '
    Dim xlApp As Object
    On Error Resume Next
 
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    
    If Not xlApp Is Nothing Then
      
        xlApp.Quit
        Set xlApp = Nothing
    End If
End Sub


Sub TabloKarsilastirSon()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim array1 As Variant, array2 As Variant
    Dim i As Long, j As Long
    Dim cellAddress As String
    Dim summaryWs As Worksheet
    Dim summaryRow As Long
    Dim foundPosition As Long
    Dim isFound As Boolean
    

    Set ws1 = Worksheets("Sayfa1")
    Set ws2 = Worksheets("Sayfa2")
    Set rng1 = ws1.UsedRange
    Set rng2 = ws2.UsedRange
    

    On Error Resume Next
    Set summaryWs = Worksheets("KarsilastirmaSonuclari")
    On Error GoTo 0
    If summaryWs Is Nothing Then
        Set summaryWs = Sheets.Add(After:=Sheets(Sheets.Count))
        summaryWs.Name = "KarsilastirmaSonuclari"
    Else
        summaryWs.Cells.Clear
    End If
    

    summaryWs.Cells(1, 1).Value = "Hücre Adresi"
    summaryWs.Cells(1, 2).Value = "Durum"
    

    summaryRow = 2 '
    
    
    For Each cell In rng1
        cellAddress = cell.AddressLocal(False, False)
        isFound = False
        For Each compareCell In rng2
            If cell.Value = compareCell.Value Then
                isFound = True
                Exit For
            End If
        Next compareCell
        
        If Not isFound Then
        
            summaryWs.Cells(summaryRow, 1).Value = cellAddress
            summaryWs.Cells(summaryRow, 3).Value = cell.Value
            summaryWs.Cells(summaryRow, 2).Value = "Sayfa2'de Yok, Sayfa1'de Var"
          
            cell.Interior.Color = RGB(255, 0, 0)
            summaryRow = summaryRow + 1
        End If
    Next cell
    
    
    For Each cell In rng2
        cellAddress = cell.AddressLocal(False, False)
        isFound = False
        For Each compareCell In rng1
            If cell.Value = compareCell.Value Then
                isFound = True
                Exit For
            End If
        Next compareCell
        
        If Not isFound Then
        
            summaryWs.Cells(summaryRow, 1).Value = cellAddress
             summaryWs.Cells(summaryRow, 3).Value = cell.Value
            summaryWs.Cells(summaryRow, 2).Value = "Sayfa1'de Yok, Sayfa2'de Var"
          
            cell.Interior.Color = RGB(255, 0, 0)
            summaryRow = summaryRow + 1
        End If
    Next cell
    
    
    For Each summaryCell In summaryWs.Range("B2:B" & summaryWs.Cells(summaryWs.Rows.Count, 2).End(xlUp).Row)
        If summaryCell.Value = "Sayfa1'de Yok, Sayfa2'de Var" Or summaryCell.Value = "Sayfa1'de Var, Sayfa2'de Yok" Or summaryCell.Value = "Sayfa2'de Yok, Sayfa1'de Var" Or summaryCell.Value = "Sayfa2'de Var, Sayfa1'de Yok" Then
          
            summaryCell.Offset(0, -1).Interior.Color = RGB(255, 0, 0)
        End If
    Next summaryCell
 
End Sub

 

[alicimri]

Sadece A sütunları karşılaştıracaksanız.
Tablonuzun A1 hücresinden başladığını varsaydım.
2. Bir sayfa oluşturun, 1. Sayfadaki tabloyu kopyalayıp, yapıştırın.
Her iki sayfadaki Tablolar aynı satır ve sütunda olsun.
Aşağıdaki kodu 1. Sayfanın kod modülüne yapıştırın.

Private Sub Worksheet_Change(ByVal Target As Range)
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
If Application.CountIf(s2.Columns(1), s1.Cells(i, 1)) = 0 Then
yaz = yaz & s1.Name & " Satır" & i & Chr(10)
End If
Next
For x = 1 To s2.Cells(Rows.Count, 1).End(3).Row
If Application.CountIf(s1.Columns(1), s2.Cells(x, 1)) = 0 Then
yaz = yaz & s2.Name & " Satır" & x & Chr(10)
End If
Next
If Len(yaz) <> 0 Then
MsgBox yaz
s2.Range("A1").CurrentRegion.Clear
s1.Range("A1").CurrentRegion.Copy s2.Range("A1")
End If
End Sub

 

[birdhane]

Teşekkürler arkadaşlar deyeyeyim.