Move Data showing in Reverse To Sheet 2

[Sharid]

I have a spread sheet which has some data, some of the emails in the data are in reverse. I have a code that can reverse the data so that is not an issue. My problem is I ahve to ID all the emails that are in reverse and move them to sheet2 as my current code an not determin which data is NOT in reverse.

The emails are shown as such MyEmail@gmail.com will show as moc.liamg@liamEyM

Currently I am using auto filter to remove from sheet 1 to sheet 2 and then I reverse them the correct way. Is there a Faster way to do this?. I was thinking that almost all email should END with a dot in the second or third character e.g. .com or .uk

If it does not have a dot in the LAST 2 or 3 characters then then move the whole row to sheet2 row 2 down and clear and delete the row in sheet1. I can then use my reverse code to correct the data.

Data will be in Sheet 1 columns A and B, Column B will have the emails, therefore the whole row will need to move to sheet2 Row2 down

There are too many email endings to list all, but all should have a dot in the last 2 or 3 characters.

 

[Sharid]

I can use this to copy and paste the rows to sheet2, however I can not set it to look for a dot after the second or third last characters. e.g. .com or .uk. Therefore if it DOES NOT have a dot copy the rows to sheet2

Option Explicit

Sub CopyPaste()

Dim Cell As Range

With Sheets(1)
    ' loop column B until last cell with value 
    For Each Cell In .Range("B1:B" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        If Cell.Value <> "." Then
             ' Copy>>Paste in 1-line 'NEED TO SET IT TO ROW2 AS ROW1 HAS HEADINGS
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

 

[Sharid]

This is far as I have got, however it copies everthing over when it should only copy over items WHOS 3rd and 4th characters are not a dot.

Private Sub CommandButton1_Click()

Dim items As Variant
Dim Cell As Range

    With Sheets(1)
        ' loop column B until last cell with value
        For Each Cell In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
            If (Left(items, 4) <> ".") Then ' IF 4TH ITEM FROM RIGHT IS NOT A . THEM COPY TO SHEET 2
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
            If (Left(items, 3) <> ".") Then ' IF 3RD ITEM FROM RIGHT IS NOT A . THEM COPY TO SHEET 2
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
        End If
    Next Cell
    End With

End Sub