Boa tarde!!

Mande seu modelo compactado, para entendermos melhor sua dúvida.

Att

Luciene,

Da forma que você especifiou na sua mensagem, você não está copiando para as linhas abaixo como dito na sua mensagem, pois se A1 = ITEM1-ITEM2-ITEM3 e esses valores devem ser copiados para as linhas abaixo, o correto deveria ser:
A1 = ITEM1
A2 = ITEM2
A3 = ITEM3

e não
A1 = ITEM1
B1 = ITEM2
C1 = ITEM2

Se você fizer assim, você está copiando paras coluna ao lado. Correto?

Assim, informe se esse meu raciocínio está correto e se a cópia é para ser feita paras as linhas logo abaixo.

Wagner,

Desculpa, seu raciocínio está corretíssimo. Tenho que copiar os dados para as as linhas logo abaixo.

Obrigada.

Lucienne

Alexandre,

Obrigada pela atenção.

Pesquisei e encontrei este código e alterei o valor, porém não esta funcionando porque ele procura exatamente o valor -.

Sei que isto é só o inicio, mas para mim seria de grande ajuda. Meu arquivo contem muitos dados e se repetem em 3 abas.

---------------------
Sub InserirLinhas()

Dim i As Long

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(i, "A").Value = "-" Then
Rows(i).Insert
End If
Next
End Sub
---------------------

Obrigada,

Lucienne

Lucienne,

Veja se assim atende a sua necessidade.

Wagner,

Obrigada você foi muito rápido, quando rodei a macro fiquei super feliz. Porém quando fiz as alterações para minha realidade não funcionou exatamente como eu gostaria.

Coloquei um planilha com exemplos fictícios.

Obrigada pela ajuda e sua rapidez.

Grata,

Lucienne

Lucienne,

Infelizmente, não consegui elaboar uma macro que faça isso.

Espero que outro integrante aqui do fórum possa te ajudar.

Talvaez assim:

Sub separar()
Dim uLin As Integer, X As Integer, j As Integer
    uLin = Sheets("Base Original").Cells(Cells.Rows.Count, 1).End(xlUp).Row

    Range("A2:A" & uLin).Select
    Selection.TextToColumns Destination:=Range("M2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", TrailingMinusNumbers:=True
Dim lCol As Integer
        lCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
X = 0
For i = 2 To uLin
    For j = 13 To lCol
        If Cells(i, j + 1) <> "" Then
        Rows(i + 1 & ":" & i + 1).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        X = X + 1
        End If
    Next
    j = 13
        For t = 0 To X
        Cells(i + t, 1) = Cells(i, j + t)
        Cells(i + t, 2) = Cells(i, 2)
        Next
i = i + X: uLin = uLin + X
X = 0
Next
    Columns("M:R").Select
    Selection.Clear
    Range("A1").Select
End Sub

Boa tarde!!

Se entendi bem veja se é isto...

Sub Traco_AleVBA()
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    For j = LR To 2 Step -1
        city = Cells(j, 1)
        State = Cells(j, 2)
        If InStr(city, "-") > 0 Then
            arr = Split(city, " - ")
            numrows = UBound(arr)
            Cells(j + 1, 1).Resize(numrows, 1).EntireRow.Insert
            Cells(j + 1, 1).Resize(numrows, 2).Value = Cells(j, 1).Resize(1, 2).Value
            For i = 0 To numrows
                Cells(j + i, 1).Value = arr(i)
            Next
        End If
    Next
End Sub

Bom dia,

Obrigada a todos, estou baixando a base desta semana e vou testar. Assim que tiver uma resposta, aviso vocês e coloco o tópico como resolvido.

[ ]´s

Lucienne

Reinaldo,

Fez exatamente o que eu estava precisando, porém tenho que executar mais de uma vez. Ele faz a primeira vez em alguns registros e deixa alguns, sendo necessário executar mais uma vez. Tirando este fato faz o que estava precisando.

Alexandre,

Também funcionou perfeitamente para o que estou precisando.

Obrigada novamente.

[ ]´s

Lucienne