Este fórum está sendo desativado

[Dawiborg]

Olá,
Gostaria da ajuda de vocês com a seguinte situação.

É possível criar uma macro que utilize o nome do fornecedor na coluna "B" para criar uma nova guia, movendo para lá todas as informações deste fornecedor?

Exemplo, Fornecedor Matrix. Criar uma guia com o nome Matrix e copiar as informações para esta nova guia com tudo que for do fornecedor Matrix, incluindo o cabeçalho (material, fornecedor e valor), sem alterar a ordem.

Grato se puderem ajudar.
Anexo exemplo com os dados.

[osvaldomp]

#
Experimente:

Código: Selecionar todos

Sub InserePlanilhas()
 Dim k As Long, x As Long, ws As Worksheet
  Set ws = ActiveSheet
  For k = 2 To ws.Cells(Rows.Count, 1).End(3).Row
   With ws
    x = Application.CountIf(.[B:B], .Cells(k, 2))
    Sheets.Add.Name = .Cells(k, 2)
    .[A1:C1].Copy [A1]
    .Cells(k, 1).Resize(x, 3).Copy [A2]
    Columns("A:C").AutoFit
    k = k + x - 1
   End With
  Next k
End Sub

[JCabral]

Caro @osvaldomp,

TOP

Espetacular seria para o caso de a planilha já existir, apenas adicionar os dados em falta

Jorge Cabral

[osvaldomp]

#
Salve, Jorge.

Código: Selecionar todos

Sub InserePlanilhasV2()
 Dim k As Long, x As Long, ws As Worksheet
  Application.ScreenUpdating = False
  Set ws = ActiveSheet
  With ws
   For k = 2 To .Cells(Rows.Count, 1).End(3).Row
    x = Application.CountIf(.[B:B], .Cells(k, 2))
    If Evaluate("IsError('" & .Cells(k, 2).Value & "'!A1)") = True Then
     Sheets.Add.Name = .Cells(k, 2)
     .[A1:C1].Copy [A1]
    End If
    .Cells(k, 1).Resize(x, 3).Copy Sheets(.Cells(k, 2).Value).Cells(Rows.Count, 1).End(3)(2)
    Sheets(.Cells(k, 2).Value).Columns("A:C").AutoFit
    k = k + x - 1
   Next k
   '.Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row) = ""
  End With
End Sub

[JCabral]

Caro @osvaldomp,

Sempre que corro a Macro ela vai acrescentando os mesmos valores, será que está faltando algo antes de voltar a escrever?

Forte abraço
Jorge

[osvaldomp]

Sim, o código irá replicar o s dados existentes na Planilha1 e se aqueles dados não forem renovados então serão repetidos a cada vez que rodar a macro.

Nesses casos em que se utiliza uma planilha para a entrada de dados e uma macro para distribuir os dados pelas respectivas planilhas, é desejável apagar os dados ao final da macro, se não o fizer, a planilha de entrada irá acumular desnecessariamente dados que já estão nas demais planilhas.

Para apagar os dados replicados basta descomentar esta linha no código que passei ~~~> '.Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row) = ""