Cara, não sei porque...
Mas uma dúvida sua dá até medo....
kkkkkkkkkkk

Vou dar uma olhada aqui...
Abraço

Robert,
Como você disse, essa é uma planilha fictícia. Como virá a original? Somente a Sheet "BD" e quer crie as novas Sheets e coloque as informações correspondentes ou essas Sheets das Vantagens já existe e quer apenas que sejam localizadas e que elas sejam transportadas para lá?

Robert,
Como você disse, essa é uma planilha fictícia. Como virá a original? Somente a Sheet "BD" e quer crie as novas Sheets e coloque as informações correspondentes ou essas Sheets das Vantagens já existe e quer apenas que sejam localizadas e que elas sejam transportadas para lá?

Grande Bernardo,quanto tempo!
Como vai você ?

Todas as informações vão estar na "BD" quase 300mil linhas as vezes mais , quero separar o "OS NOMES VANTAGENS NA COLUNA D" em Sheets , ou seja , tudo que for "ABONO" vai está em uma sheets e tudo que for insalubridade vai está em outra "sheets" com suas respectivas informações e assim sucessivamente com as demais.

Um grande abraço,

Robert.

Amigo!
fiz esse código e funcionou, verifica se é isso que precisa... nao usei loop na planilha, pois 300 mil linhas deixaria muito lento, dessa forma está bem rápido.
deixei a planilha anexa tb.
abs
[email protected]

Sub teste()

Dim matriz(4) As String

matriz(1) = "ABONO"
matriz(2) = "INSALUBRIDADE"
matriz(3) = "SALÁRIO"
matriz(4) = "GRATIFICAÇÃO"

Application.ScreenUpdating = False

Sheets("BD").Activate
On Error Resume Next
ActiveSheet.ShowAllData 'limpa todos os filtros
On Error GoTo 0

'ponto para limpar todas as outras planilhas
For lin = 1 To 4
Sheets(matriz(lin)).Range("A2:K1000000").ClearContents
Next lin
'encontra a última linha da sua planilha
fim = Sheets("BD").Range("A" & Rows.Count).End(xlUp).Row

For lin = 1 To 4
Sheets("BD").Activate
Sheets("BD").Range("$A$1:$K$" & fim).AutoFilter Field:=4, Criteria1:=matriz(lin) 'filtro na coluna porte
Range("A2:K" & fim).Copy
Sheets(matriz(lin)).Activate
Range("A2").PasteSpecial xlPasteValues

Next lin
End Sub

Cara, tenta utilizar esse código:

Option Explicit
Dim Counter As Long

Public Sub SheetVantagem()
Dim wb              As Workbook
Dim wsBD            As Worksheet
Dim StartTime       As Double
Dim EndTime         As Double
Dim ColVantagem     As Long
Dim UltLVantagem    As Long
Dim UltLBD          As Long
Dim i               As Long
Dim j               As Long

    StartTime = Timer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wb = ThisWorkbook
    Set wsBD = wb.Worksheets("BD")
    
    UltLBD = wsBD.Cells(Rows.Count, 1).End(xlUp).Row
    ColVantagem = 4
    Counter = 0
    
    'Limpa as planilhas
    For i = wb.Worksheets.Count To 1 Step -1
        If Not wb.Worksheets(i).Name = "BD" Then
            wb.Worksheets(i).Delete
        End If
    Next i
    
    'Cria as planilhas e atribui os valores
    For i = 2 To UltLBD
        Call CheckSheet(wsBD.Cells(i, ColVantagem).Value)

        UltLVantagem = wb.Worksheets(wsBD.Cells(i, ColVantagem).Value).Cells(Rows.Count, 1).End(xlUp).Row + 1
        For j = 1 To 11
            wb.Worksheets(wsBD.Cells(i, ColVantagem).Value).Cells(UltLVantagem, j).Value = wsBD.Cells(i, j).Value
        Next j
    Next i
    
    wsBD.Activate
    
    Set wsBD = Nothing
    Set wb = Nothing
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    EndTime = Timer
    MsgBox "Processo concluído com sucesso!" & vbNewLine & _
           "Foram criadas " & Counter & " planilhas." & vbNewLine & _
           "Tempo do processamento: " & EndTime - StartTime & " segundos."

End Sub

Public Sub CheckSheet(ByVal NomeSheet As String)
Dim wb              As Workbook
On Error GoTo CriarSheet

    Set wb = ThisWorkbook
        
    wb.Worksheets(NomeSheet).Activate
        
    GoTo Finalizar

Exit Sub
CriarSheet:
    wb.Worksheets.Add After:=wb.Worksheets(wb.Worksheets.Count)
    wb.Worksheets(wb.Worksheets.Count).Name = NomeSheet
    Counter = Counter + 1
Finalizar:
Set wb = Nothing
    
End Sub

Qualquer coisa da o grito.
Abraço

Daniel, Bernardo.

Como tenho mais de 54 vantagens na planilha original então não funcionou , creio que seja só adaptar , vou verificar com mais calmo e retornarei.

Obrigado !

O que não funcionou Robert?

Bernardo,
Bom dia , amigo. Desculpa a demora , estava abafado.

veja essa nova planilha vide anexo.

Obrigado !

Fala Robert,

O problema estava no Nome da primeira Sheet que era BD e agora é COMPARATIVO.

Outro problema encontrado era no nome da planilha. Não aceita alguns caracteres.

Já fiz o teste e está funcionando.
Demorou cerca de 3 minutos para processar tudo.
Vou tentar aperfeiçoar o código um pouco para melhorar isso....
Marcae.

Blz , se vc puder colocar a planilha ficticia em anexo te agradeço, veja que nessa última que enviei tem mais uma coluna com valores .

Um grande abraço,

Blz... Reparei nisso e estou fazendo pegar todas as colunas.

Vlw! Te mandei uma MP.

Cara, 1 minuto e 40 segundos....

Vê se ajuda.
Qualquer coisa da o grito.
Abraço