Set vbSheet = vbBook.Worksheets(1) satırı ile vbSheet.Cells.Select satırlarının arasını değiştirip dener msiniz?

Set vbSheet = vbBook.Worksheets(1)

' vbExcel.Visible = True

Dim fdArray, fdCount, rdCount

fdCount = 0

For Each fdExcel In rsExcel.Fields

fdCount = fdCount + 1

    If fdCount > 1 Then

    fdArray = fdArray & "<,>" & fdExcel.Name

    Else

    fdArray = fdExcel.Name

    End If

Next

 

' Excel Belgesine Başlıklar Aktarılıyor

With vbSheet.Range("A1")

.Resize(1, fdCount) = Split(fdArray, "<,>")

.Resize(1, fdCount).Font.Color = &HFF0000

.CopyFromRecordset rsExcel

End With

 



vbSheet.Cells.Select