jrerzinger,

Entendo que não é o ideal mas como sou garoto novo em macros, deixo uma alternativa via fórmulas para a distribuição dos dados nas colunas B e F (não negritos listados).

Algum fera em VBA provavelmente vai "fechar o caixão" com relação ao resto.

Se não avançar avise.

Abs,

Dei uma mexida a partir de onde deu erro e deixei uns comentários. Veja se ajuda

Dim str_Arq_modelo, str_Arq_Dados As String
Dim sites() As String 'Lista de sites que terao relatório feito

Sub Gerar_Relatorios()
'Coleta nomes de sites
    Sheets("Menu").Select
    colunaComDados = 2 'B
    If Range("P13") = "" Then
    MsgBox "FAVOR INSERIR A DATA DE INÍCIO DOS RELATÓRIOS"
    GoTo 2
    End If
    If Range("r13") = "" Then
    MsgBox "FAVOR INSERIR A DATA DE FIM DOS RELATÓRIOS"
    GoTo 2
    End If
    
    StrIni = Range("T13").Value
    StrFim = Range("V13").Value
    StrDatarelatorio = Range("S15").Value
    linhaINI = 13
    linha = linhaINI
    Do Until Cells(linha, colunaComDados) = ""
        linha = linha + 1
    Loop
    
    ReDim sites(linha - linhaINI, 1 To 2) 'Alterado 20071214
    
    For itemSel = 1 To UBound(sites)
        sites(itemSel, 1) = Cells(itemSel + linhaINI - 1, colunaComDados) 'linhas da coluna B 'Alterado 20071214
        sites(itemSel, 2) = CStr(Cells(itemSel + linhaINI - 1, 4)) 'linhas da coluna D - fase de expansao 'Alterado 20071214
    Next itemSel
    
    numSitesSelec = UBound(sites)

    str_Path_Relat = Range("I9")
    
    If (str_Path_Relat = "") Then
        MsgBox "Arquivos faltando. Favor preencher todos os campos"
        Exit Sub
    End If
    
    str_WinMacro = ActiveWorkbook.Name

    'Linha de Status Bar:-----------------------
    str_StatusINI = Application.StatusBar
    Application.ScreenUpdating = False
        
    For itemSel = 1 To numSitesSelec
     'Abre o modelo e gera relatórios dados
     
        'Preencher os dados
     
        empID = sites(itemSel, 1) 'Determina qual é a empresa que irá ser analisado o relatório
              

        'Inserindo dados do Cabeçalho do Relatório
        Sheets("AGENDA_SEMANAL").Select
        Range("b3") = empID
        Range("F4") = StrIni
        Range("F5") = StrFim
        Range("L5") = StrDatarelatorio
        'Seleciona a planilha que serão localizados os dados
        
        Sheets("DADOS").Select
        Final = Cells(65536, 1).End(xlUp).Row
        
        j = 10 'faltou definir o valor de j, por isso estava dando erro
        
            For i = 6 To Final
                
        Sheets("DADOS").Select 'vc estava selecionando a planilha DADOS antes de começar o loop, depois ele selecionava outra planilha e não voltava
                If Cells(i, 1).Font.Bold = True Then
                    GoTo 1
                End If
                           
                If Cells(i, 11) <> empID Then
                    GoTo 1
                End If
                
                    SrtTarefa = Cells(i, 2).Value
                    SrtPavimento = Cells(i, 3).Value
                    SrtInicio = Cells(i, 7).Value 'estava com a coluna 3, eu alterei
                    SrtFinal = Cells(i, 9).Value 'estava com a coluna 3, eu alterei
                
                Sheets("AGENDA_SEMANAL").Select
                linhafinal = Cells(157, 2).End(xlUp).Row + 1
                
                
                
                    Range("b" & j).Value = SrtTarefa 'aqui estava com erro de grafia Str...
                    Range("F" & j).Value = SrtPavimento 'aqui estava com erro de grafia Str...
                    Range("N" & j).Value = SrtInicio
                    Range("O" & j).Value = SrtFinal
                'Next j
                
                j = j + 2 'coloquei esse contador para atualizar ir para uma linha vazia na planilha
1
            Next i
            
        
        'str_Arq_modelo = ActiveWorkbook.Name
            Sheets("AGENDA_SEMANAL").Select
            Sheets("AGENDA_SEMANAL").Copy
            
        
        ActiveWorkbook.SaveAs str_Path_Relat & " " & empID & ".xls"
        
        relatWinTitle = ActiveWorkbook.Name

    Next itemSel
    
    
'Linha de Status Bar:----------------------------------
    Application.StatusBar = str_StatusINI
    Application.ScreenUpdating = True
    
    'Fecha o arquivo de dados
'    Workbooks(str_Arq_Dados).Close SaveChanges:=False

2
End Sub