Jump to content
Fórum Script Brasil
  • 0

Dúvida VBA


Lucas Breder

Question

Fala galera, eu tenho uma planilha mais ou menos com essas informações:

richtext_content.png

E eu queria que para cada linha, ela "explodisse" em uma outra planilha com a quantidade como padrão, exemplo:
richtext_content.png
No caso do primeiro item, o Airpod Case Transparent / Airpod, que tem 20 unidades para a loja Anália Franco, gostaria que com alguma macro/automação, ele explodisse material em 20 linhas, numeradas em ordem, de 1 a 20.
O objetivo é colocar etiquetas em materiais separados para essa loja em específico e com a quantidade correta, podendo bater/auditar a quantidade em cada etiqueta.

Link to comment
Share on other sites

6 answers to this question

Recommended Posts

  • 0
59 minutos atrás, Basole disse:

@Lucas Brederpelo que entendi, voce quer que cada linha, fosse distribuida em uma nova planilha (aba) e preenchesse, repetindo,  as linhas de acordo com a coluna quantidade. é isso? 

 

@Basole correto, é mais ou menos isso sim. E na nova planilha, tivesse uma coluna quantidade com esse "contador" (no caso do primeiro exemplo, 1/20, para indicar que seria o primeiro item em um total de 20.

Link to comment
Share on other sites

  • 0

@Lucas Brederveja se é isso..

Vendo a imagem que disponbilizou, considerei que os dados estão dispostos nas Colunas A,B, C e a partir da linha 2

A macro define o nome das novas abas como Linha 1, Linha 2, Linha 3, etc...

*Poderia nomea-las de acordo com a coluna "A" do seu exemplo, mas como tens caracteres especiais e pode haver espaços, enfim os nomes da coluna "A" não seguem um padrão, e pode gerar erros, na hora de renomear interrompendo a execução do codigo.

Em seguida replica os dados de acordo com a sua 2a imagem, alterando a coluna "B" como por exemplo 1/20, 2/20, assim sucessivamente. 

* A coluna "B" é formatada como "texto", caso contrario o excel "entende" como data 

Na coluna "D" da aba Base, a macro cria um hyperlink para ir direto a respectiva aba.

 

Sub ExplodirLinhaParaOutrasSheets()
    Dim irt As Long, i As Long, wsb As Worksheet
    Dim strTab As String, sh As Worksheet, ShNoEx As Boolean

    Dim irs         As Long: irs = 2

    Set wsb = ActiveSheet    ' define a aba BASE

    Do Until VBA.IsEmpty(wsb.Cells(irs, 1))
        strTab = "LINHA " & irs    ' define nome da ABA
        ShNoEx = False

        ' verif. se já existe a aba com o nome da coluna "A"
        For Each sh In ThisWorkbook.Worksheets
            If VBA.UCase(sh.Name) = VBA.UCase(strTab) Then
                ShNoEx = True
            End If
        Next sh

        If Not ShNoEx Then
            With ThisWorkbook
                'Cria Nova Aba, Caso não Exista
                .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = strTab
                wsb.Rows(1).Copy Sheets(strTab).Rows(1)
                With .Sheets(strTab)

                    For i = 1 To wsb.Cells(irs, "B").Value2
                        irt = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                        .Cells(irt, "A") = wsb.Cells(irs, "A").Value2
                        .Cells(irt, "B").NumberFormat = "@"    ' Formata a linha coluna Quant. como texto
                        .Cells(irt, "B") = i & "/" & wsb.Cells(irs, "B")
                        .Cells(irt, "C") = wsb.Cells(irs, "C").Value2
                    Next i

                    .Columns.AutoFit    ' ajusta as colunas da nova aba

                End With
            End With
        End If

        With wsb
            .Activate
            .Cells(irs, "D").Activate
            ' *** Na COLUNA "D" => cria um hiperlink, para ir direto p/ aba
            ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", _
                    SubAddress:="'" & Sheets(strTab).Name & "'!A1", TextToDisplay:="CLICK AQUI"
        End With
        irs = irs + 1
    Loop

End Sub

 

Edited by Basole
Link to comment
Share on other sites

  • 0

Opa! Cara, é mais ou menos isso aí mesmo, tá quase perfeito.

 

A única coisa é que eu preferia que eles ficassem todas em uma mesma aba, ao invés de várias abas distintas. 

 

É tranquilo fazer essa alteração? Como se fosse a mesma coisa que você fez, mas todos na mesma aba, um seguido do outro.

Link to comment
Share on other sites

  • 0

@Lucas Bredersegue com as alteracões solicitadas.

 

Sub ExplodirLinhaParaOutrasSheets()
    Dim irt As Long, i As Long, wsb As Worksheet
    Dim strTab As String, sh As Worksheet, ShNoEx As Boolean
    Dim irs         As Long: irs = 2

    Set wsb = ActiveSheet    ' define a aba BASE

    Do Until VBA.IsEmpty(wsb.Cells(irs, 1))
        strTab = "DADOS REPLICADOS"    ' Altere AQUI nome da nova ABA, desejado
        ShNoEx = False

        ' verif. se já existe a aba strTab
        For Each sh In ThisWorkbook.Worksheets
            If VBA.UCase(sh.Name) = VBA.UCase(strTab) Then
                ShNoEx = True
            End If
        Next sh

        With ThisWorkbook
        If Not ShNoEx Then
                'Cria Nova Aba, Caso não Exista
                .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = strTab
                wsb.Rows(1).Copy Sheets(strTab).Rows(1)
        End If
                
                With .Sheets(strTab)
                  .Activate
                    For i = 1 To wsb.Cells(irs, "B").Value2
                        irt = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                        .Cells(irt, "A") = wsb.Cells(irs, "A").Value2
                        .Cells(irt, "B").NumberFormat = "@"    ' Formata a linha coluna Quant. como texto
                        .Cells(irt, "B") = i & "/" & wsb.Cells(irs, "B")
                        .Cells(irt, "C") = wsb.Cells(irs, "C").Value2
                    Next i
              
                End With
            End With
        irs = irs + 1
    Loop
   
   Sheets(strTab).Columns.AutoFit ' ajusta as colunas da nova aba
   
End Sub

 

 

 

Edited by Basole
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      651.7k
×
×
  • Create New...