Página 1 de 1
Criar guias com informação da célula e copiar informações
Enviado: 01 Abr 2021 às 15:52
por 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.
Re: Criar guias com informação da célula e copiar informações
Enviado: 01 Abr 2021 às 17:49
por osvaldomp
#
Experimente:
Código: Selecionar todosSub 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
Re: Criar guias com informação da célula e copiar informações
Enviado: 01 Abr 2021 às 18:17
por JCabral
Caro @osvaldomp,
TOP
Espetacular seria para o caso de a planilha já existir, apenas adicionar os dados em falta
Jorge Cabral
Re: Criar guias com informação da célula e copiar informações
Enviado: 02 Abr 2021 às 14:19
por osvaldomp
#
Salve, Jorge.
Código: Selecionar todosSub 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
Re: Criar guias com informação da célula e copiar informações
Enviado: 02 Abr 2021 às 16:08
por 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
Re: Criar guias com informação da célula e copiar informações
Enviado: 02 Abr 2021 às 17:59
por 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) = ""