VBA Help Needed - Need code to only Copy Rows to existing Multiple worksheet when Column T<>X and ignore/not copy when X=Y

[RPE]

Currently the code below will look at column X for value then search for a matching worksheet and copy row to worksheet. If the sheet does not exist, it also creates it.

Need Code below to copy of all the records to the destination sheet only when the value in Column T is not equal to Column X. When the value in T = X then it should ignore row/rows and not copy.

VBA Code:
Sub CopyDataToSheets()
Dim sh As Worksheet
Dim dic As Object
Dim c As Range
Dim ky As Variant
Dim lr As Long, lr2 As Long

Application.ScreenUpdating = False

Set sh = Sheets("Report")
Set dic = CreateObject("scripting.dictionary")

If sh.AutoFilterMode Then sh.AutoFilterMode = False
lr = sh.Range("T" & Rows.Count).End(xlUp).Row

For Each c In sh.Range("T2:T" & lr)
dic.Item(c.Value) = Empty
Next c

For Each ky In dic.Keys
sh.Range("A1:T1").AutoFilter 20, ky
If Evaluate("ISREF('" & ky & "'!A1)") = False Then
Sheets.Add(, Sheets(Sheets.Count)).Name = ky
sh.AutoFilter.Range.Range("A1:Y" & lr).Copy Range("A1")
Else
lr2 = Sheets(ky).Range("T" & Rows.Count).End(xlUp).Row + 1
sh.AutoFilter.Range.Range("A2:Y" & lr).Copy Sheets(ky).Range("A" & lr2)
End If
Next ky

sh.Select
sh.ShowAllData
Application.ScreenUpdating = True
End Sub


Sample Screen Shot

 

[DanteAmor]

Hello @RPE


Try this:

Sub CopyDataToSheets()
  Dim sh As Worksheet
  Dim dic As Object
  Dim c As Range
  Dim ky As Variant
  Dim lr As Long, lr2 As Long, lc As Long
  
  Application.ScreenUpdating = False
  
  Set sh = Sheets("Report")
  Set dic = CreateObject("scripting.dictionary")
  
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("T" & Rows.Count).End(3).Row
  lc = sh.Cells(1, Columns.Count).End(1).Column
  
  For Each c In sh.Range("T2:T" & lr)
    dic.Item(c.Value) = Empty
  Next c
  
  For Each ky In dic.Keys
    sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 20, ky
    sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 24, "<>" & ky
    
    If Evaluate("ISREF('" & ky & "'!A1)") = False Then
      Sheets.Add(, Sheets(Sheets.Count)).Name = ky
      sh.AutoFilter.Range.Range("A1", sh.Cells(lr, lc)).Copy Range("A1")
    Else
      lr2 = Sheets(ky).Range("T" & Rows.Count).End(xlUp).Row + 1
      sh.AutoFilter.Range.Range("A2", sh.Cells(lr, lc)).Copy Sheets(ky).Range("A" & lr2)
    End If
  Next ky
  
  sh.Select
  sh.ShowAllData
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result.
Respectfully
Dante Amor
--------------​