Trying to Overwrite Cell Data with VBA Macro

[jdub21]

Hello,
This is my first post and I am a moderate newb at writing VBA. I am struggling with overwriting existing cells...... Here is my scenario

Excel file with different worksheets for each state in the US (50+)
I have created 3 worksheets within the file so I can be able to have the specific records accumulate in one sheet... i.e. Onboarded, Not Interested, Still Thinking, etc.
Because of the multiple sheets, I do not have a unique identifier (ex. 1,2,3,4,5 so on for column A) was hoping to use maybe the phone column
Also I would either like to overwrite all the results in the summary sheets I created i.e. Onboarded, Not Interested, Still Thinking, etc. or have the new ones added float to the bottom.
I really need help on this because right now with this code, it just adds everything to the bottom so there are duplicates. I have added my worksheet so you can see. Also as you can see, I am writing the code for each state so if there is an easier way, i am all ears.

Sub CopyOnboarded()

Dim TransIDField As Range
Dim TransIDCell As Range
Dim ATransWS As Worksheet
Dim HTransWS As Worksheet




Set ATransWS = Worksheets("AL")
Set TransIDField = ATransWS.Range("A2", ATransWS.Range("A2").End(xlDown))
Set HTransWS = Worksheets("Onboarded")

For Each TransIDCell In TransIDField

    If TransIDCell.Interior.Color = RGB(198, 239, 206) Then
       
ActiveWorkbook.Worksheets("Onboarded").AutoFilter.Sort.SortFields.Clear
       
       
        TransIDCell.Resize(1, 12).Copy Destination:= _
            HTransWS.Range("A8").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
           
    End If

Next TransIDCell

HTransWS.Columns.AutoFit




Set ATransWS = Worksheets("CA")
Set TransIDField = ATransWS.Range("A8", ATransWS.Range("A8").End(xlDown))
Set HTransWS = Worksheets("Onboarded")


For Each TransIDCell In TransIDField

    If TransIDCell.Interior.Color = RGB(198, 239, 206) Then
       
        TransIDCell.Resize(1, 12).Copy Destination:= _
            HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
           
    End If

Next TransIDCell

HTransWS.Columns.AutoFit

End Sub

 

[jdub21]

Being worked on

 

[Fluff]

Please do not mark a post as the solution, when it does not contain one. Thanks

 

[Fluff]

Duplicate to: Duplicate Cells

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.