bug in vba - move data from sheet1 to sheet 2

I am attempting to move data from sheet1 to sheet2 based on date. While it appears to be working, I get correct lines of out put, the rows are all scambled. Its ike they are randomly placed.

Here is code I am using:

Public Sub test()
'*  I named cell containing the Base Date "BASE_DATE" to refer to it as named range
Dim ws1     As Worksheet
Dim ws2     As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim sheetname As String
Dim xRow1   As Long
Dim xRow2   As Long
Dim lstRow1 As Long
Dim lstRow2 As Long
Dim bDate1   As Date
Dim maxComm1 As Long
Dim cell   As Range
Dim rng1    As Range
Dim rng2    As Range


Dim counter As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("test sheet")
counter = 1
ws1.Activate
bDate1 = Int(ws1.Cells("76", "k").Value) ' normally I have time attached thus reason for INT
lstRow1 = ws1.Range("A2:A71").End(xlDown).Row       '*  calculate the last filled row in column A
For Each cell In ws1.Range("a2:a" & lstRow1)    '*  loop through each cell in filled range column A
    If ws1.Cells(cell.Row, "k").Value < Int(Range("BASE_DATE").Value) And ws1.Cells(cell.Row, "A").Value > 0 Then  '*  check if the a < base date and data in A value > 0
        'maxComm1 = 0                             '*  store 0 to the maxComm value
        For Each rng1 In ws1.Range("A" & cell.Row & ":A" & lstRow1) '*  loop though the comms column
            If ws1.Cells(rng1.Row, "A").Value = cell.Value And ws1.Cells(cell.Row, "k").Value <= bDate1 Then
  maxComm1 = ws1.Cells(cell.Row, "A").Value  '*  calculate the maxComm1 value
                If ws1.Cells(cell.Row, "a").Value = maxComm1 Then xRow1 = rng1.Row               '*  if the comm value = the maxComm value then store that row number in xRow1
            End If
        Next rng1
        
        xRow2 = ws2.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row
        If counter = 1 Then ws2.Cells(xRow2, "c").Value = bDate1
        If maxComm1 > 0 Then '*  if the maxComm found is greater than 0 then populate Sheet2
        ws2.Activate
              '*  find the first empty row in Sheet 2 in Column d
           
            ws2.Cells(xRow2, "d").Value = ws1.Cells(xRow1, "A").Value '*  stores the # in Sheet 2 column d row xRow 2 through I
'            ws1.Activate
 '           ws1.Cells(xRow1, "A").Value = ""
 '           ws2.Activate
            ws2.Cells(xRow2, "e").Value = ws1.Cells(xRow1, "b").Value
'            ws1.Activate
'            ws1.Cells(xRow1, "B").Value = ""
'            ws2.Activate
            ws2.Cells(xRow2, "f").Value = ws1.Cells(xRow1, "c").Value
'            ws1.Activate
'            ws1.Cells(xRow1, "c").Value = ""
 '           ws2.Activate
            ws2.Cells(xRow2, "g").Value = ws1.Cells(xRow1, "d").Value
'            ws1.Activate
'            ws1.Cells(xRow1, "d").Value = ""
 '           ws2.Activate
            ws2.Cells(xRow2, "h").Value = ws1.Cells(xRow1, "e").Value
 '           ws1.Activate
'            ws1.Cells(xRow1, "E").Value = ""
            ws2.Cells(xRow2, "I").Value = ws1.Cells(xRow1, "f").Value
'            ws1.Cells(xRow1, "f").Value = ""
            
        
        counter = counter + 1
        End If
         End If
        ' mmcomm1 = 0
Next cell
End Sub

I have attached sheet with data from sheet 1, and example of sheet 2 and a CORRECTED sheet 2 of whats its supposed to look like, I also included a test page showing what my current results show.

Any assistance would be a big help. More importantly tell me what the heck did I miss and why random rows.

This post had already been answered by the time I posted mine.