form üzerinden excele gönder yapıyorum,
iplik noların bir kısmı hatalı gözüküyor,
12/2 ===>>> 2.Ara olarak gözüküyor,
 #1
			
				
			
			
			
			
#1
		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(23/06/2022, 15:24)berduş yazdı: 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
' Excel Belgesine Başlıklar Aktarılıyor
Set vbSheet = vbBook.Worksheets(1)
For Each fld In rsExcel.Fields
    x = x + 1
    vbSheet.Cells(1, x) = fld.Name
Next fld
vbSheet.Range("A1").Resize(1, x).Font.Color = &HFF0000
vbSheet.Range("A2").CopyFromRecordset rsExcel
vbSheet.Range("A1").Select
vbSheet.Cells.EntireColumn.AutoFit
 
vbBook.SaveAs "D:\Desktop\Dokumaya Gönderilen-" & Date & ".xlsx"
vbExcel.QuitvbSheet.Range("A2").CopyFromRecordset rsExcel