1

Olá ! possuo uma planilha com duas abas: Na PLAN1 tenho uma única coluna com vários dados, porém que não seguem uma sequência. Os valores que podem ser encontrados nessa coluna são: Código do produto (Ex: AAA7X), A xxxx, B xxxx, C xxxx, D xxxx, E xxxx, F xxxx, G xxxx e Total xxxx. Preciso que os valores que estão entre um código de produto e outro sejam copiados e colados em uma linha na PLAN2. Na PLAN2 possuo um cabeçalho com os dados possíveis de serem encontrados na coluna da PLAN1. Segue as imagens:

PLAN1 - Única coluna com dados - De onde os dados deve ser copiados, ex: Uma linha na PLAN2 deve ser De A1:A7 (a célula A8 já possui outro código de produto)

PLAN2 - A PLAN2 já possui um cabeçalho (em negrito) os dados devem ser colados nas colunas correspondentes

Estou aprendendo VBA com a gravação de Macros, mas este não consigo realizar a colagem nas colunas corretas ! Gostaria de um auxílio na programação do código, como faço para executar a cópia e colagem de células na coluna correspondente e para que o ele vá para a linha seguinte na Plan2 quando um novo código de produto seja encontrado na Plan1 ! Obrigada

1
  • No caso demonstrado provavelmente ainda não precisará de VBA, creio que com apensar algumas fórmulas conseguirá fazer o que quer. Gostaria de confirmar se o código pode repetir a letra, exemplo, se pode existir um A 15000 e um A 13580 ou até três códigos iniciados com A para o mesmo produto, no caso AA75Y? E teria já de pronto o código de todos os produtos?
    – Evert
    Commented 12/09/2017 às 9:29

1 Resposta 1

1

Olá, sob estas circunstâncias específicas que relatou, tente inserir um novo módulo na edição do VBA, colar o código abaixo e ir até a aba que deseja o resultado e executá-lo:

Sub getdata()

Dim ln, linha As Long
Dim coluna, caract As Integer
Dim info As String
Dim valor As Double

ln = Sheets(1).Range("A1000000").End(xlUp).Row

'limpeza da plan2
Sheets(2).Range("A2:AA1000000").ClearContents
'fim limpeza

For i = 1 To ln

    If Sheets(1).Range("A" & i).Value <> "" Then

        On Error GoTo -1
        On Error GoTo nx

        info = Sheets(1).Range("A" & i).Value

            If Application.WorksheetFunction.Find(" ", info, 1) > 0 Then

                caract = Application.WorksheetFunction.Find(" ", info, 1)
                valor = Mid(info, caract + 1, 20)
                refCol = Mid(info, 1, caract - 1)
                coluna = WorksheetFunction.Match(refCol, Sheets(2).Rows(1), 0)
                Sheets(2).Range("A1000000").End(xlUp).Offset(0, coluna - 1).Value = valor

            Else

nx:
        Sheets(2).Range("A1000000").End(xlUp).Offset(1, 0).Value = info

        End If

    Else: End If

Next

End Sub

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .