Problema com Macro! Devolver pesquisa de acordo com data inserida

[Anasap]

Oi,

Estou tentando fazer uma macro que devolva o resultado de uma pesquisa(query) de acordo com uma data inserida numa folha excel. Não sei o que estou a fazer de errado, só está a devolver o cabeçalho dos campos

Na folha scr_hcurso, tenho os dados da ligação ao sql bem como o código. Também consta a data inserida pelo utilizador em outra folha.

Na folha HorCursoFinal é susposto devolver o resultado da pesquisa, da query que está na scr_hcurso, está a devolver só o cabeçalho a partir da célula A3.

Não sei o que estou a fazer errado, podem me ajudar?

Segue o código da macro:

Sub macro ()

Sheets("scr_hcurso").Select ' seleciona data da da celula H2 da folha scr_hcurso e copia para a celula B13 da mesma folha
Range("H2").Select
Selection.Copy
Range("B13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A3").Select
Sheets("HorCursoFinal").Select

Sheets("HorCursoFinal").Select

Dim srv As String
Dim db As String ' nome do bd
Dim idu As String
Dim pw As String
Dim cod1 As String ' cod1 ao cod7 é a instrução sql
Dim cod2 As String
Dim cod3 As String
Dim cod4 As String
Dim cod5 As String
Dim cod6 As String
Dim cod7 As String ' data inserida pelo utilizador
Dim nome As String
Dim rg As String

' seleciona os campos da folha scr_hcurso

srv = Sheets("scr_hcurso").Range("srv").Value
db = Sheets("scr_hcurso").Range("db").Value
idu = Sheets("scr_hcurso").Range("idu").Value
pw = Sheets("scr_hcurso").Range("pw").Value
cod1 = Sheets("scr_hcurso").Range("cod1").Value
cod2 = Sheets("scr_hcurso").Range("cod2").Value
cod3 = Sheets("scr_hcurso").Range("cod3").Value
cod4 = Sheets("scr_hcurso").Range("cod4").Value
cod5 = Sheets("scr_hcurso").Range("cod5").Value
cod6 = Sheets("scr_hcurso").Range("cod6").Value
cod7 = Sheets("scr_hcurso").Range("cod7").Value
nome = Sheets("scr_hcurso").Range("nome").Value
rg = Sheets("scr_hcurso").Range("rg").Value

Sheets("HorCursoFinal").Select
Range("A1").Select
Range(rg).Select
Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DRIVER=SQL Server;SERVER=" & srv & ";UID=" & idu & ";PWD=" & pw & ";APP=Microsoft® Query;WSID=" & srv & ";DATABASE=" & db & "" _
, Destination:=Range(rg))
.CommandText = Array( _
cod1 _
, cod2 _
, cod3 _
, cod4 _
, cod5 _
, cod6 _
, cod7)

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True

End With
Range("A3").Select
End Sub

Cump,