Disponibiliza uma cópia do arquivo.

nao to conseguindo subir o arquivo acredita?

Salve na nuvem e compartilhe o link

Tentei com este código e não estou conseguindo. dá erro na linha e negrito. alguém consegue me dizer porque?

Sub RelParaiso()

Dim OrdemParaiso As Object
Dim i As Long
Dim j As Long
Dim Loja As String
Dim linha As Long
Dim lista As String
Dim Ulin As Long
Dim ultimaLinha As Long
Dim Total As Long



linha = 2
Loja = "Paraiso"
i = 7
j = 5

Ulin = Sheets("Cadastro funcionário").Cells(Cells.Rows.Count, 1).End(xlUp).Row


'Faça enquanto a ordem de impressão for diferente de vazio
[b]Do While OrdemParaiso < 19[/b]

'se loja=paraiso e setor = ordem
    If Sheets("Cadastro funcionário").Cells(j, 1) = Loja And Sheets("Cadastro funcionário").Cells(j, 2) = Sheets("Controles").Cells(i, 19) Then
    'cola o cabeçario
            Sheets("Controles").Range("AD5:BM6").Copy
            Sheets("RelModelo").Cells(linha, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Sheets("RelModelo").Cells(linha, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Sheets("RelModelo").Cells(linha, 1).Value = "Setor : " & Sheets("Controles").Range("s:" & i)
            
            linha = linha + 2
       End If
           'cola os dados dos funcionarios do setor
                For j = 5 To Ulin
                      If Sheets("Cadastro funcionário").Cells(j, 1) = "Paraiso" And Sheets("Cadastro funcionário").Cells(j, 2) = Sheets("Controles").Range("s:" & i) Then
                            Sheets("Cadastro funcionário").Range("C" & j & ":BA" & j).SpecialCells(xlCellTypeVisible).Select
                            Selection.Copy
                            Sheets("RelModelo").Cells(linha, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Sheets("RelModelo").Cells(linha, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            j = j + 1
                            linha = linha + 1
                            ultimaLinha = linha
                            Total = Total + 1
            End If
        Next
        
        Sheets("RelModelo").Cells(linha, 1).Value = "Total " & Total
        linha = linha + 1
        Total = 0
  i = i + 1
  
  Loop

Application.ScreenUpdating = True
End Sub

Algué saberia me dar uma luz?