Sub test()
    Dim r As Long
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Общий")
    For r = 1 To sh.Cells(sh.Rows.Count, 2).End(xlUp).Row
        If sh.Cells(r, 2) Like "*ам*" Or sh.Cells(r, 2) Like "*ат*" Then
            With ThisWorkbook.Sheets(IIf(sh.Cells(r, 2) Like "*ам*", "ам", "ат"))
                sh.Rows(r).Copy Destination:=.Rows(.Cells(.Rows.Count, 2).End(xlUp).Row + 1)
            End With
        End If
    Next r
    sh.Range("A1").Select
    MsgBox "Done"
End Sub