Olá Bruna, disponibilize sua Pasta de Trabalho num lugar como o SendSpace.com para termos uma ideia melhor da estrutura de sua tabela e agilizar a resolução do seu problema. Não se esqueça de postar aqui o link gerado pelo SendSpace.
Você pode também usar as ferramentas deste fórum para anexar a Pasta de Trabalho também.
Se acha que essa Pasta de Trabalho é muito grande, tudo bem, mande apenas 100 linhas e apague as outras no modelo que disponibilizar.

Boa tarde, espero conseguir expressar minha dúvida e conseguir também uma solução

Trabalho com uma planilha de faturamento para calcular royalties, esse faturamento é feito com livros, cada livro tem seu royalties específico, essa planilha é retirada do sistema especificando cada produto vendido, o meu problema está quando o produto é um kit (promoção da empresa), pois cada kit contém de 2 a 8 livros, toda vez que trabalho nessa planilha preciso abrir as informação somente de kits e descriminar, hoje eu insiro manualmente as linhas necessárias abaixo do linha do kit e coloco as informações. Ex. abaixo

Ele vem do sistema assim (imaginem que isso é uma planilha de excel rsrsrs)
kit|n kit| produto|Série| qtd|preoço de capa
| | dd | 11 | 1| R$ 10,00
kit| 008| kit | | 1| R$ 24,90
| | PX | 10 | 1| R$ 8,50
| | LL | 2 | 1| R$ 7,50

Eu preciso abrir somente o que está com kit (as vezes "kit", as vezes "col", as vezes "cax") dizendo que esse kit representa tais livros para ficar no mesmo formato que os outros produtos/livros. Ex:

| | dd | 11 | 1| R$ 10,00
kit| 008| dd | 8 | 1| R$ 8,3
kit| 008| dL | 7 | 1| R$ 8,3
kit| 008| LAB | 6 | 1| R$ 8,3
| | PX | 10 | 1| R$ 8,50
| | LL | 2 | 1| R$ 7,50

Obs: Quando abro o kit por produto tenho que dividir seu valor total pela quantidade de produtos desse kit.

Bom, eu fiz um banco de dados das coleções e seus kit, o que preciso é saber como eu posso incluir essas linhas e discriminar esses kits por produto sem ter que ficar add linha por linha, pois são mais de 3 mil linhas por arquivo.

Alguém pode me ajudar?

Grata

O código abaixo não atende todas as solicitações que você fez porque tive dúvidas:

Sub Exemplo()
    Dim ws As Worksheet
    Dim lRow As Long
        
    With ThisWorkbook
        .Sheets("Original").Copy _
          Before:=.Sheets(1)
        Set ws = .Sheets(1)
    End With
    
    lRow = 2
    Do
        If _
          ws.Cells(lRow, "D") = "col" Or _
          ws.Cells(lRow, "D") = "cax" Or _
          ws.Cells(lRow, "D") = "kit" Then
            ws.Rows(lRow).Copy
            ws.Rows(lRow + 1).Resize(2).Insert
            lRow = lRow + 3
        Else
            lRow = lRow + 1
        End If
    Loop While ws.Cells(lRow, "A") <> 0
End Sub

Execute-o na Pasta de Trabalho que você disponibilizou e me diga como calcular o valor dos intervalos H17:H19 e M17:M19 para fazer tudo que você pediu.

Os valores dos intervalos h17:h19 estavam errados, na verdade eu pego o valor do kit/col e divido pela quantidade de livros que possui essa coleção, de forma que eu rateio a coleção nos livros

Eu executei a macro, adorei, só que exite um problema, ele está inserindo os dados a cada 3 linhas, no exemplo do kit 3 são 4 livros, e em outras coleções vão até 8 livros. Você pode me ajudarrrr

E se não for pedir muito srsrs (como estou abusada hoje) rsrs

na Sheet3 tem o preço de capa na coluna h ref cada livro, quando edito a original, alem de abrir a coleção por livro na coluna I eu coloco através de procv o preço de capa de cada livro (essa é a forma que eu uso, existe uma forma melhor para colocar na macro?

Esqueci outra coisinha rsrsrs, to folgada d+ hoje rsrsrs desculpa o incomodo

depois que insere a linha eu preciso substituir o conteudo da coluna d, e, f com as informações da sheet3 e,f,g,

A forma como os dados estão dispostos em Sheet3 não está bom. Se você não manter a formatação e estrutura de itens col/cax/kit do jeito que está atualmente, pode ser que a macro erre em inserir o número correto de livros da coleção.

Sub Exemplo()
    Const c_sResumo As String = "Resumo"
    Const c_sBD As String = "Sheet3"
    
    Dim ws As Worksheet
    Dim lRow As Long
    Dim lEle As Long
    Dim lQtd As Long
        
    Application.ScreenUpdating = False
    
    With ThisWorkbook
        'Apaga Planilha de Resumo, se existir
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets(c_sResumo).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        
        .Sheets("Original").Copy Before:=.Sheets(1)
        Set ws = .Sheets(1)
        ws.Name = c_sResumo

        lRow = 2
        Do
            If _
              ws.Cells(lRow, "D") = "col" Or _
              ws.Cells(lRow, "D") = "cax" Or _
              ws.Cells(lRow, "D") = "kit" Then
                lEle = EleOf(ws.Cells(lRow, "C"), .Sheets(c_sBD).Columns("A"))
                lQtd = .Sheets(c_sBD).Cells(lEle, "E").End(xlDown).Row - lEle + 1
                
                ws.Rows(lRow).Copy
                ws.Rows(lRow + 1).Resize(lQtd - 1).Insert
                
                ws.Cells(lRow, "H").Resize(lQtd) = ws.Cells(lRow, "H") / lQtd
                
                .Sheets(c_sBD).Cells(lEle, "H").Resize(lQtd).Copy
                ws.Cells(lRow, "I").PasteSpecial xlPasteValues
                
                .Sheets(c_sBD).Cells(lEle, "E").Resize(lQtd, 3).Copy
                ws.Cells(lRow, "D").PasteSpecial xlPasteValues
                
                lRow = lRow + lQtd - 1
            End If
            lRow = lRow + 1
        Loop While ws.Cells(lRow, "A") <> 0
    End With
End Sub

Private Function EleOf(ByVal vTermo As Variant, ByVal vVetor As Variant) As Long
    'Retorna o número da linha ou coluna de uma célula numa linha ou coluna.
    'Se vVetor for uma Variant() ou String(), retorna o índice do elemento no vetor.
    'Caso não seja encontrada nenhuma ocorrência, é retornado 0.
    On Error Resume Next
    Select Case TypeName(vVetor)
        Case "Range"
            If vVetor.Columns.Count = 1 Then
                'vVetor é uma coluna
                EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Row - 1
            ElseIf vVetor.Rows.Count = 1 Then
                'vVetor é uma linha
                EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Column - 1
            End If
        Case "Variant()", "String()"
            EleOf = WorksheetFunction.Match(vTermo, vVetor, 0)
    End Select

    Application.ScreenUpdating = True
End Function

Realmente a Sheet3 não está boa, mas não consigo imaginar um forma de deixa-la melhor, se tiver alguma ideia por favor de ajude.