Excel vba - colocando texto especifico no começo da celula em uma coluna

[isabela queiroz]

Preciso adicionar um texto especifico no início de cada célula da tabela, sendo que a coluna necessaria da tabela começa na celula "C17" 

 

 preciso que esses numeros da coluna "item number" a partir do NXH - 2.4.1.20.0470 fique com "364-NTK1-" na frente, eu ja fiz o começo do codigo mas não sei prosseguir pra ele seguir sequencia fazendo para as proximas celulas ate a ultima, não sei muito bem como usar o Next no VBA 

 

Sub Text_Esp ()

Windows("MACRO MAURO.xlsm").Activate
    Sheets("INDO").Select
  
 Cells.Find(What:="item number", After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(1, 0).Range("A1").Select
            
Dim c As Range
Dim D As Range

    For Each c In Selection
        If c.Value <> "" Then c.Value = "364-NTK1-" & c.Value
        ActiveCell.Offset(1, 0).Range("A1").Select
        
    Next c
    
End Sub

e apos isso preciso fazer uma macro semelhante a essa mas que crie uma caixa de dialogo perguntando o final do item number em questão. ex "qual o final do item number? e eu colocaria "-BS-1" 

 

no final das contas preciso que fiquei assim " 364-NTK1- NXH - 2.4.1.20.0470 -BS-1 " e que isso seja copiado ate a ultima cellula preenchida da coluna 

 

 

[Midori]

@isabela queiroz Veja se assim resolve,

 

Sub Text_Esp()
    Dim Item    As Range
    Dim Final   As String
    
    Final = InputBox("Qual o final do item number?")
    
    Set Item = ThisWorkbook.Sheets("INDO").Cells.Find( _
        What:="item number", LookIn:=xlValues, LookAt:=xlWhole)
        
    If Not Item Is Nothing Then
        Set Item = Item(2)
        While Item <> ""
            Item = "364-NTK1-" & Item & Final
            Set Item = Item(2)
        Wend
    End If
End Sub

 

[isabela queiroz]

@Midori Exatamente isso, muito obrigada voce esta me ajudando demais a resolver muito problemas que estou tendo com essa macro.. 

@Midori para não precisar abrir mais um topico, que estou abrindo o dia todo kkkkk teria como voce me ajudar com mais uma coisinha..

 

tem essa parte da macro aqui que é o inicio, ela ate ta funcionando mas quando chega no final da esse erro aqui 

 

não sei como evitar ou só ignorar já que a sub faz o que tem que ser feito no final das contas 

Sub começando()
 


'Windows("Project BOM.CO Check list - Boa Sorte_Rev00 - Analise.xlsx").Activate 'SELECIONANDO A PLANILHA DA JANELA DO PROJETC BOM.CO
    'Sheets("Details").Select
    
    
 Windows("BOM.CO pra teste.xlsx").Activate
    Sheets("Details").Select
      
    Cells.Find(What:="PN", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    
Windows("MACRO MAURO.xlsm").Activate
    Sheets("INDO").Select
        Cells.Find(What:="part number", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
Windows("BOM.CO pra teste.xlsx").Activate
    Sheets("Details").Select
    
        Cells.Find(What:="PN", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select
            
        ActiveCell.Offset(1, 0).Select
        'ActiveCell.Value = Selection.Copy
    
        'Define o valor da Variavel
        valorProcura = ActiveCell.Value

    Sheets("Pier Distribution").Select
    
    'Procura a variavel
        Cells.Find(What:=valorProcura, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
         xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False).Select


    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
        Selection.Copy
    Range("C13").Select
        ActiveSheet.Paste
    Range("D14").Select
    Range(Selection, Selection.End(xlDown)).Select


'mudar range baseado na onde ficar o que copiei
    Range("D17:D19").Select
        Application.CutCopyMode = False
        ActiveSheet.Range("$C$13:$E$19").RemoveDuplicates Columns:=2, Header:=xlNo

    
    ThisWorkbook.Sheets("Pier Distribution").Range("D17:D30").RemoveDuplicates Columns:=Array(4, 5), Header:=xlYes

'--------------------- funciona pra cima - mas da erro no final    ------------------------------------------

End Sub

 

 

[Midori]

@isabela queiroz O erro acontece na tentativa de remover os duplicados (RemoveDuplicates)? Comente essa linha ou veja se o range e o argumento de columns estão corretos.