Using Copy/Paste and QueryTable Operations

[Hudel Holmes]

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
(e-mail address removed)

Thanks you much if you have any understanding of this.


Sub Copy_And_Query()
Dim vX as Variant
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 = "PathWAI 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