Как выделит слова

Уважаемый Gacol.
Ваш пример переносит любой текст, который содержит хотя бы один пробел между словами, т.е. он перенесёт и два слова и двадцать два слова. Да и проверка всех 65536 строк тоже не лучшая идея. Вот исправленный вариант.

Private Sub CommandButton1_Click()
'проверка в столбце "A"

iFirst = 1
iLast = ActiveSheet.Cells(65536, 1).End(xlUp).Row

Set newBook = Workbooks.Add: i = 0

For iRow = iFirst To iLast
iDate = Application.Trim(Cells(iRow, 1).Value)
iSymbol = InStr(iDate, " ")
If iSymbol > 0 Then
If InStr(iSymbol + 1, iDate, " ") = 0 Then
i = i + 1
newBook.Sheets(1).Cells(i, 1) = Cells(iRow, 1).Value
End If
End If
Next

'newBook.SaveAs Filename:="c:\example.xls"
'newBook.Close

End Sub

Спасибо gacol и pashulka, очень помагли :)

Ну например надо вырезать и столбик А и столбик B,тогда как быть? На этом коде меняю Row на 2,но ничего не получается.И если можно скажите как зделать вместо Copy --вырезать( Cut).

Private Sub CommandButton1_Click()

iFirst = 1
iLast = ActiveSheet.Cells(65536, 1).End(xlUp).Row

Set newBook = Workbooks.Add: i = 0

For Each iCell In Range(Cells(iFirst, 1), Cells(iLast, 2))
iDate = Application.Trim(iCell.Value)
iSymbol = InStr(iDate, " ")
If iSymbol > 0 Then
If InStr(iSymbol + 1, iDate, " ") = 0 Then
i = i + 1
newBook.Sheets(1).Cells(i, 1) = iCell.Value
End If
End If
Next

'newBook.SaveAs Filename:="c:\example.xls"
'newBook.Close

End Sub
--------------------------------------------------
Private Sub CommandButton1_Click()

iFirst = 1
iLast = ActiveSheet.Cells(65536, 1).End(xlUp).Row

Set newBook = Workbooks.Add: i = 0

For iCol = iFirst To 2
For iRow = iFirst To iLast
iDate = Application.Trim(Cells(iRow, iCol).Value)
iSymbol = InStr(iDate, " ")
If iSymbol > 0 Then
If InStr(iSymbol + 1, iDate, " ") = 0 Then
i = i + 1
newBook.Sheets(1).Cells(i, 1) = Cells(iRow, 1).Value
End If
End If
Next
Next

'newBook.SaveAs Filename:="c:\example.xls"
'newBook.Close

End Sub

Порядок поиска нужных слов несколько разный.

P.S.
1) iRow - это строка, а не столбец.
2) Копирование в этом примере не применяется, так как Gacol предложил вариант более правильный, чем Tuco

Друг если не очень трудно могбы ты написать код делаюший эти(надо там зделать койкакие изминени,но незнаю какие, воше не разбераюсь в VBA, но очень нужен этот код):

Есть слово и ее перевод на отдельном ячейке (например A и B ). Надо вырезать все это и вставить на другой файл. порядок слов должен соблюдатся.

Правильно ли я Вас понял :
Имеется столбец A, B ~ 10000 строк
Если в столбце A имеется сочетание из двух слов (), то их необходимо переместить в новый файл и создать новый список + данные из соседней ячейки в столбце B.

Private Sub CommandButton1_Click()
'проверка в столбце "A"

iFirst = 1
iLast = ActiveSheet.Cells(65536, 1).End(xlUp).Row

Set newBook = Workbooks.Add: i = 0

For iRow = iFirst To iLast
iDate = Application.Trim(Cells(iRow, 1).Value)
iSymbol = InStr(iDate, " ")
If iSymbol > 0 Then
If InStr(iSymbol + 1, iDate, " ") = 0 Then
i = i + 1
newBook.Sheets(1).Cells(i, 1) = Cells(iRow, 1).Value
newBook.Sheets(1).Cells(i, 2) = Cells(iRow, 2).Value
End If
End If
Next

'newBook.SaveAs Filename:="c:\example.xls"
'newBook.Close

End Sub

Автор идеи : gacol
Автор исправлений : pashulka

Большое спасибо pashulka и gacol-у :)