Criar linhas e Copiar conteudo.

[darlansantoro]

Tenho um planilha com mais 5.000 linhas a coluna G contem as informações a baixo:

Coluna G

25, 33, 117, 122, 123

25, 117, 33, 120, 121, 118, 122, 143

25, 32

33, 120, 121, 118, 122

Preciso de uma formula ou macro que faça o seguinte:

Com base na coluna G crie uma nova linha para cada número separado por virgula e copie todas as outras colunas para a linha nova

Obrigado.

[zinhovba]

Boa noite!!

Consegue adaptar ..?

Option Explicit
Sub TenteAdaptar()

    Dim w1 As Worksheet, wR As Worksheet
    Dim lr As Long, r As Long, Sp, n As Long
    Application.ScreenUpdating = False
    Set w1 = Worksheets("Sheet1")
    If Not Evaluate("ISREF(NomeDaGuia!A1)") Then Worksheets.Add(After:=w1).Name = "NomeDaGuia"
    Set wR = Worksheets("NomeDaGuia")
    wR.UsedRange.Clear
    w1.UsedRange.Copy wR.Range("A1")
    lr = wR.Cells(Rows.Count, 1).End(xlUp).Row
    For r = lr To 1 Step -1
        If InStr(wR.Cells(r, 2), ",") > 0 Then
            Sp = Split(wR.Cells(r, 2), ",")
            wR.Rows(r + 1).Resize(UBound(Sp)).Insert
            wR.Cells(r, 2).Resize(UBound(Sp) + 1) = Application.Transpose(Sp)
            wR.Cells(r, 1).Resize(UBound(Sp) + 1) = wR.Cells(r, 1)
        End If
    Next r
    wR.UsedRange.Columns.AutoFit
    wR.Activate
    Application.ScreenUpdating = True
End Sub

[darlansantoro]

Olá, Zinhovba

Obrigado pelo retorno, será que tem como comentar o codigo, pois sou leigo.

o que quero é que cada vez que a coluna G tiver um numero separado por virgula a macro crie uma nova linha e copie todas a outras colunas do A ao Q para a nova linha, mas a coluna G fique com o valor correspondente.

ex:

25, 37, 40 ( aqui na coluna G pode variar de 2 até 8 itens)

quero que fique assim:

A... B... C... D... E... F.................................G

colunas copia da acima............................ 25

colunas copia da acima............................ 37

colunas copia da acima............................ 40

a primeira linha ( a que já tenho deve ficar com o primeiro numero da coluna G e os demais criar linhas novas)

Acho que fui mais claro agora.

Obrigado,

[darlansantoro]

Este codigo funcionou perfeitamente.

Sub fnc()

Dim lngRow As Long

Dim lngCount As Long

Dim var As Variant

Dim wks As Worksheet

Set wks = ActiveSheet

With wks

For lngRow = .Cells(.Rows.Count, "G").End(xlUp).Row To 1 Step -1

For Each var In Split(.Cells(lngRow, "G"), ",")

.Rows(lngRow).Copy

.Rows(lngRow + 1).Insert

.Cells(lngRow + 1, "G") = var

Next var

.Rows(lngRow).Delete

Next lngRow

End With

End Sub