Find a strings in a cell and copy the found cell to a specific cell by VBA-CodePudding

need help in Excel VBA, please. I am trying to find a string in a cell and if found want to copy the cell to a specific cell, want to loop for next rows until end of data rows. I used the code as follows it find and copy but copy to the next cell, I need in a specific cell. Thank you.

    Sub TEST()

    Dim c As Range

    For Each c In Range("B1:K100")
        If InStr(1, c.Text, "Address:") Then
            c.Copy Destination:=c.Offset(ColumnOffset:=1)
        End If
    Next c

    End Sub

CodePudding user response：

This is my guess at what you are attempting to do

Sub Test()

    Dim src As Worksheet: Set src = ThisWorkbook.Worksheets("Source")

    Dim c As Integer, r As Integer
    Dim lastRow As Integer: lastRow = src.Cells(src.Rows.Count, 1).End(xlUp).Row ' assumes your lowest piece of content will be in column 1
    Dim lastCol As Integer: lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column ' assumes your rightmost piece of content will be located in row 1
    Dim destinationCol As Integer: destinationCol = lastCol   1

    For r = 1 To lastRow
        For c = 1 To lastCol
            If InStr(1, src.Cells(r, c).Value, "Address:") Then
                src.Range(src.Cells(r, c), src.Cells(r, c)).Copy Destination:=src.Range(src.Cells(r, destinationCol), src.Cells(r, destinationCol))
            End If
        Next c
    Next r

End Sub