Перенос значения ячейки

[mary91847]

Здравствуйте! помогите составить макрос, который будет искать в файле определенный текст в ячейке и переносить его в следующий столбец на этой же строчке. Заранее спасибо за любую помощь)

[Aleksandr H.]

Вариант решения без переноса в соседнюю ячейку пробовали?

[mary91847]

не получается(

[Aleksandr H.]

как вариант.

Sub ShowAdrCells()
    Dim TxtForFind As String, RngForFind As Range, FirstAddress As String, i As Integer
    Dim rng() As Variant, sh As String, rg As String
    TxtForFind = "dick" '<====== WE WILL FIND THIS WORD !!!
    ReDim Preserve rng(0)
    For i = 1 To Sheets.Count
        With Sheets(i).UsedRange
            Set RngForFind = .Find(TxtForFind, LookIn:=xlValues, LookAt:=xlPart)
            If Not RngForFind Is Nothing Then
                FirstAddress = RngForFind.Address
                rng(UBound(rng)) = Sheets(i).Name & "!" & RngForFind.Address
                ReDim Preserve rng(UBound(rng) + 1)
                Do
                    Set RngForFind = .FindNext(RngForFind)
                    If RngForFind.Address <> FirstAddress Then
                        rng(UBound(rng)) = Sheets(i).Name & "!" & RngForFind.Address
                        ReDim Preserve rng(UBound(rng) + 1)
                    End If
                Loop While RngForFind.Address <> FirstAddress
            End If
        End With

    Next
    For i = LBound(rng) To UBound(rng) - 1
        sh = Left(rng(i), InStr(rng(i), "!") - 1)
        rg = Right(rng(i), Len(rng(i)) - InStr(rng(i), "!"))
        Sheets(sh).Range(rg).Offset(0, 1) = Sheets(sh).Range(rg)
    Next
End Sub

[mary91847]

спасибо большущее!