QueryTable with Copy/Paste Functions

[Hudel]

The following code is part of an Excel 2000 VBA module.

The routine Copy_And_Query is called to copy the format template in the
Range(“A1:AH50”)

The Cell(“C61:Hxx) values are magically obtained from the Query
function where xx is = RecordCount + 60 of the SQL selection.

All of this works great except for the fact that Row 61 always loses
the format properties obtained from Row11, while Rows 62 through 100
remain like rows 12 through 50 regardless of the Row count returned
from the SQL selection.

Queue Paso????

Regards,
Hudel

Thanks you much if you have any understanding of this.


Sub Copy_And_Query()

Dim lCnt as Long
Dim xSheet as Excel.WorkSheet
Dim xBook as Excel.WorkBook
Dim sSql as String
Dim sCopyTo as String
Dim sCopyFrom as String

Set xBook = ActiveWorkBook
Set xSheet = .Sheets(“Report”)

sCopyTo = "A51"
sCopyFrom = "A1:AH50"

With xSheet
..Range(sRefer).Copy
..Range(sCopyTo).PasteSpecial xlPasteAll
End With ‘xSheet

SSql = “Select Col3, Col4, Col5, Col6, Col7, Col8 “ _
& “From My_Table “ _
& “Where Col1=’Y’ and Col2>10”

LCnt = Query_Run(xSheet, sSql, “C11”)

End Sub

Function Query_Run _
(xSheet As Excel.Worksheet, _
sSql As String, _
sRange As String) _
As Long
Dim rsQuery As ADODB.Recordset
Dim qt As QueryTable

On Error GoTo Query_Run_Error

With xSheet

Set rsQuery = Get_Rs(sSql, Query_Run) ‘Get AdoDB RecortSet _
where Query_Run is set to the Record Count

Set qt = .QueryTables.Add(rsQuery, .Range(sRange))

With qt
..Name = "Path Import"
..FieldNames = False
..RowNumbers = False
..FillAdjacentFormulas = False
..PreserveFormatting = True
..RefreshOnFileOpen = False
..BackgroundQuery = True
..RefreshStyle = xlOverwriteCells
..SavePassword = False
..SaveData = True
..AdjustColumnWidth = False
..RefreshPeriod = 0
..WebFormatting = xlWebFormattingAll
..WebPreFormattedTextToColumns = True
..WebConsecutiveDelimitersAsOne = True
..WebSingleBlockTextImport = False
..WebDisableDateRecognition = False
..Refresh BackgroundQuery:=False
End With 'qt
End With
Exit Function

Query_Run_Error:
vX = Err.Description
Resume Next
End Function