vba excel: how to copy characters from a cell to another

I think this will help you:

Option Explicit

Sub test()

    Dim LastrowA As Long, i As Long, AppearA As Long, AppearB As Long
    Dim strA As String, strB As String


    With ThisWorkbook.Worksheets("Sheet1")

        LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastrowA

            strA = .Range("A" & i).Value
            strB = .Range("C" & i).Value

            'Check if strA appears in strB
            AppearA = InStr(1, strB, strA)
            If AppearA > 0 Then
                .Range("B" & i).Value = strA
                Exit For
            End If

            'Check if strB appears in strA
            AppearB = InStr(1, strA, strB)
            If AppearB > 0 Then
                .Range("B" & i).Value = strB
                Exit For
            End If

        Next i

    End With

End Sub

Thank you so much for help.
after few days i’ve found solution for problem in my question.
infact, this is my solution and I hope to be good for helping anyone need something like this.

Sub AssociazioneRotabiliPerPivot()

Dim LastrowA, LastrowC As Long, i, j As Long, AppearA As Long, AppearB As Long
Dim strA As String, strB As String

With ThisWorkbook.Worksheets("sheet1")

    LastrowA = .Cells(.Rows.count, "A").End(xlUp).Row
    LastrowC = .Cells(.Rows.count, "C").End(xlUp).Row

    For j = 1 To LastrowC   

        For i = 1 To LastrowA   

            strA = .Range("A" & i).Value
            strB = .Range("C" & j).Value

            AppearC = InStr(1, strA, strB)
            If AppearB > 0 Then
                .Range("B" & i).Value = strB
            End If

            If (InStr(1, strA, "CM") Or InStr(1, strA, "C4551R")) > 0 Then

                .Range("B" & i).Value = "WT"   

            ElseIf InStr(1, strA, "ETR425") > 0 Then   

                .Range("B" & i).Value = "JAZZ"  

            End If

        Next i

    Next j

End With

End Sub

Leave a Comment