VBA - Copy and paste data without column sequence to rows

Asked

Viewed 1,532 times

1

Hello ! I have a spreadsheet with two tabs: In PLAN1 I have a single column with several data, but they do not follow a sequence. The values that can be found in this column are: Product code (Ex: AAA7X), A xxxx, B xxxx, C xxxx, D xxxx, E xxxx, F xxxx, G xxxx and Total xxxx. I need the values that are between one product code and another to be copied and pasted into a line in PLAN2. In PLAN2 I have a header with the possible data to be found in the PLAN1 column. Follow the images:

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

I am learning VBA with the Macros recording, but this one I can not perform the collage in the correct columns ! I would like a help in programming the code, as I do to run the copy and paste cells in the corresponding column and for it to go to the next line in Plan2 when a new product code is found in Plan1 ! Thank you

excel vba macro

  • In the case shown probably not yet need VBA, I believe that with join some formulas will be able to do what you want. I would like to confirm if the code can repeat the letter, example, if there can be a A 15000 and a A 13580 or up to three codes started with A for the same product, in the case of AA75Y? And would have ready the code of all products?

1 answer

1

Hello, under these specific circumstances that you reported, try to insert a new module in the VBA edition, paste the code below and go to the tab that you want the result and run it:

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

Browser other questions tagged excel vba macro

You are not signed in. Login or sign up in order to post.