Ajuda com código VBA

Sub InsereLinhas()

 Dim k As Long, x As Long

  Application.ScreenUpdating = False

  For k = Cells(Rows.Count, 10).End(3).Row To 3 Step -1

  If Cells(k, 10) = Cells(k - 1, 10) Then

    x = Application.CountIf(Columns(10), Cells(k, 10))

    Rows(k + 1).Resize(2).Insert

    Range("A1:J1&quot.Copy Cells(k + 2, 1)

    Rows(k - x + 1).Resize(2).Insert

    Range("A1:J1&quot.Copy Cells(k - x + 2, 1)

    k = k - x + 1

  End If

  Next k

End Sub

GuimeM disse:

Coloque na planilha dados que representem a planilha original e coloque o resultado desejado.

GuimeM disse:

GuimeM disse:
Coloque na planilha dados que representem a planilha original e coloque o resultado desejado.

Não encontrei no seu arquivo o resultado desejado!

Informe também se é viável ordenar os dados com base na coluna J.

willian-rocha disse:

... mas se tiverem mais linhas na planilha ele não faz corretamente, ...
O resultado diferente que o código apresentou não se deve à quantidade de linhas com dados e sim à disposição dos dados na coluna J.

O espaçamento de uma linha foi apenas um exemplo também, o que eu preciso na verdade é de 4 linhas em branco de espaçamento entre as divisões
Não entendi a razão de antes você pedir uma linha se queria quatro. 

willian-rocha disse:

Em relação a coluna J, a tabela já estará em ordem do maior para o menor, mas se precisar modificar, fique à vontade.
Diferentemente da sua informação acima, no arquivo que você anexou a tabela não está ordenada pela coluna J, então o resultado desejado que você colocou fica sem validade.
Experimente o código abaixo. Os dados serão ordenados pelo código, independente de como estiverem. Se você quiser alterar a ordem, basta substituir Ascending por Descending

Sub InsereLinhasV2()

 Dim k As Long, x As Long, LR As Long

  Application.ScreenUpdating = False

  LR = Cells(Rows.Count, 10).End(3).row

  Range("A2:J" & LR).Sort Key1:=Range("J1&quot, Order1:=xlAscending

  For k = Cells(Rows.Count, 10).End(3).row To 3 Step -1

  x = Application.CountIf(Columns(10), Cells(k, 10))

  If k - x + 1 = 2 Then Exit Sub

  Rows(k - x + 1).Resize(5).Insert

  Range("A1:J1&quot.Copy Cells(k - x + 5, 1)

  k = k - x + 1

  Next k

End Sub