Veja este modelo, gera relatório entre as duas datas e salva no formato PDF na área de trabalho, falta redefinir as margens.

Olá Migue 70, ficou muito bom, porem, preciso somente de um relatorio que exiba apenas as colunas A1, A2, A3, A4 e A33.
Além disso, prefiro que ao gerar o relatório ele seja aberto e nao salvo no desktop, ou talvez os dois procedimentos.
Pode me ajudar mais uma vez nessa porque estou um pouco perdido para tentar adaptar a minha necessidade.

Abraços.

Apague tudo dentro do Userform depois Copie todo o código abaixo e cole dentro do userform1
'USERFORM1

Private Sub btExecutar_Click()
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Range("C1") = "RELATORIOS"
Range("A2") = "Nº TSO"
Range("B2") = "DATA"
Range("C2") = "LOJA"
Range("D2") = "VENDEDOR(a)"
Range("E2") = "Nº FISCAL"
Range("C1").Select
With Selection.Font
.Name = "Arial Black"
.Size = 20
End With
Columns("A:A").ColumnWidth = 13
Columns("B:B").ColumnWidth = 13
Columns("C:C").ColumnWidth = 13
Columns("D:D").ColumnWidth = 15
Columns("E:E").ColumnWidth = 20
Columns("B:B").NumberFormat = "m/d/yyyy"
Application.PrintCommunication = False
Lin = 5
Linha = 3
If CdDataINI = "" Or CdDataFIM = "" Then Exit Sub
Do Until Plan1.Cells(Lin, 2) = ""
If Plan1.Cells(Lin, 2) >= CDate(CdDataINI) And _
Plan1.Cells(Lin, 2) <= CDate(CdDataFIM) Then
Sheets(Sheets.Count).Cells(Linha, 1) = Plan1.Cells(Lin, 1)
Sheets(Sheets.Count).Cells(Linha, 2) = Plan1.Cells(Lin, 2)
Sheets(Sheets.Count).Cells(Linha, 3) = Plan1.Cells(Lin, 3)
Sheets(Sheets.Count).Cells(Linha, 4) = Plan1.Cells(Lin, 4)
Sheets(Sheets.Count).Cells(Linha, 5) = Plan1.Cells(Lin, 33)
Linha = Linha + 1
End If
Lin = Lin + 1
Loop
With ActiveSheet.PageSetup
.CenterFooter = "Página: &P / &N"
End With
Call Borda
Application.PrintCommunication = True
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
CdDataINI.Text = Date - 100
CdDataFIM.Text = Date
MsgBox "Altere as Datas de Acordo com Sua Pesquisa", vbInformation, "alerta"
End Sub
Sub Borda() 'inserir bordas
Range("A2:e" & Range("e" & Cells.Rows.Count).End(xlUp).Row).Select 'aqui linha de grade
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveWindow.SmallScroll Down:=-6
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup 'repetir o cabeçalho todas páginas
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.511811024)
.RightMargin = Application.InchesToPoints(0.511811024)
.TopMargin = Application.InchesToPoints(0.787401575)
.BottomMargin = Application.InchesToPoints(0.787401575)
.HeaderMargin = Application.InchesToPoints(0.31496062)
.FooterMargin = Application.InchesToPoints(0.31496062)
.Orientation = xlPortrait
End With
Call Botão_Impressão
End Sub
Sub Botão_Impressão() 'cria o botão impressão
ActiveSheet.Buttons.Add(401.25, 6, 90, 24.75).Select
Selection.OnAction = "IMPRIMIR"
Selection.Characters.Text = "impressão" 'liga ao botão
Range("A1").Select
End
End Sub

'AGORA EM UM MÓDULO

Sub IMPRIMIR() 'abrir comando impressão
On Error Resume Next
Application.PrintCommunication = True
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
MsgBox "CONFIGURAR MARGEM DA IMPRESSORA ", vbInformation
SendKeys "^{p}", True 'comando ctrl + p
End Sub

A linha de grade se baseá na ultima célula preenchida da ultima coluna

Fala Miguel70, mais uma vez obrigado pela ajuda, mas ainda esta dando erro na linha em que tem

Lin=5

. Não sei se é somente esse erro, pois nao consegui passar deste ponto. Abs

Apague tudo dentro do Userform depois Copie todo o código abaixo e cole dentro do userform1
'USERFORM1

Private Sub btExecutar_Click()
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Range("C1") = "RELATORIOS"
Range("A2") = "Nº TSO"
Range("B2") = "DATA"
Range("C2") = "LOJA"
Range("D2") = "VENDEDOR(a)"
Range("E2") = "Nº FISCAL"
Range("C1").Select
With Selection.Font
.Name = "Arial Black"
.Size = 20
End With
Columns("A:A").ColumnWidth = 13
Columns("B:B").ColumnWidth = 13
Columns("C:C").ColumnWidth = 13
Columns("D:D").ColumnWidth = 15
Columns("E:E").ColumnWidth = 20
Columns("B:B").NumberFormat = "m/d/yyyy"
Application.PrintCommunication = False
Lin = 5
Linha = 3
If CdDataINI = "" Or CdDataFIM = "" Then Exit Sub
Do Until Plan1.Cells(Lin, 2) = ""
If Plan1.Cells(Lin, 2) >= CDate(CdDataINI) And _
Plan1.Cells(Lin, 2) <= CDate(CdDataFIM) Then
Sheets(Sheets.Count).Cells(Linha, 1) = Plan1.Cells(Lin, 1)
Sheets(Sheets.Count).Cells(Linha, 2) = Plan1.Cells(Lin, 2)
Sheets(Sheets.Count).Cells(Linha, 3) = Plan1.Cells(Lin, 3)
Sheets(Sheets.Count).Cells(Linha, 4) = Plan1.Cells(Lin, 4)
Sheets(Sheets.Count).Cells(Linha, 5) = Plan1.Cells(Lin, 33)
Linha = Linha + 1
End If
Lin = Lin + 1
Loop
With ActiveSheet.PageSetup
.CenterFooter = "Página: &P / &N"
End With
Call Borda
Application.PrintCommunication = True
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
CdDataINI.Text = Date - 100
CdDataFIM.Text = Date
MsgBox "Altere as Datas de Acordo com Sua Pesquisa", vbInformation, "alerta"
End Sub
Sub Borda() 'inserir bordas
Range("A2:e" & Range("e" & Cells.Rows.Count).End(xlUp).Row).Select 'aqui linha de grade
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveWindow.SmallScroll Down:=-6
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup 'repetir o cabeçalho todas páginas
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.511811024)
.RightMargin = Application.InchesToPoints(0.511811024)
.TopMargin = Application.InchesToPoints(0.787401575)
.BottomMargin = Application.InchesToPoints(0.787401575)
.HeaderMargin = Application.InchesToPoints(0.31496062)
.FooterMargin = Application.InchesToPoints(0.31496062)
.Orientation = xlPortrait
End With
Call Botão_Impressão
End Sub
Sub Botão_Impressão() 'cria o botão impressão
ActiveSheet.Buttons.Add(401.25, 6, 90, 24.75).Select
Selection.OnAction = "IMPRIMIR"
Selection.Characters.Text = "impressão" 'liga ao botão
Range("A1").Select
End
End Sub

'AGORA EM UM MÓDULO

Sub IMPRIMIR() 'abrir comando impressão
On Error Resume Next
Application.PrintCommunication = True
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
MsgBox "CONFIGURAR MARGEM DA IMPRESSORA ", vbInformation
SendKeys "^{p}", True 'comando ctrl + p
End Sub

Talvez seja porque a data esta em outro formato então da erro na pesquisa, toda pesquisa se baseia pela data.
Segue modelo em anexo

Fala Miguel70,

Mais uma vez obrigado pela sua pronta ajuda.
Estou tentando modificar a minha necessidade e estou tendo dificuldades já que esta rotina é nova para mim.
Do jeito que fez esta muito bom, porem, eu gostaria de manter aquele formato em pdf e que fosse exibido assim que fosse gerado (somente com as informações de Nº TSO, DATA, LOJA, VENDEDOR e Nº da NF), assim como no primeiro modelo que me mandou. A impressão seria feita atraves do próprio arquivo PDF.

Desculpas mais uma vez.
Muito obrigado.

Talvez seja porque a data esta em outro formato então da erro na pesquisa, toda pesquisa se baseia pela data.
Segue modelo em anexo

Não tenho conhecimento se é possível abrir no formato pdf sem primeiro ser salvo no pc. Veja os exemplos em anexo e modifique para te atender. Fico grato mas meus conhecimento são limitados, no fórum tem muita gente boa para ti ajudar mais. Obrigado

Na verdade poderia ser do jeito que voce havia feito no primeiro modelo, só que com apenas as colunas de Nº TSO, DATA, LOJA, VENDEDOR e Nº da NF. O problemaq é que nao consegui entender para modificar e colocar naquele exemplo apenas essas colunas.
Mesmo assim, muito obrigado.

Abs

Resolvido Miguel 70. Obrigado mais uma vez!!!!!