toplayarak aktar kodlarında sorun

[m.gur]

Sayın Evren Gizlen beyin hazırlayıp sunduğu aşağıdaki kodlarda bir sorun yaşamaya başladım. Şöyle ki; veri1 sayfasındaki bilgileri toplayıp son1 sayfasına aktarırken ilk satırı hep boş bırakıyor. Yani ben b2 dersem b3 ten başlıyor, b3 dersem b4 ten başlıyor. Sorun nedir acaba Evren hocam bakabilirmisiniz.

Sub topla_aktar_59()
Dim conn As Object, rs As Object
Sheets("SON1").Range("B2:H65536").ClearContents
Set conn = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.Recordset")
conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;Hdr=no;imex=1"";")
rs.Open ("Select first(F1),first(F2),first(F3),first(F4),first(F5),first(f6),count (F2) from [veri1$B2:H65536] group by F2;"), conn, 1, 3
If rs.RecordCount > 0 Then
Application.ScreenUpdating = False
Sheets("SON1").Range("B2").CopyFromRecordset rs
Sheets("SON1").Select
Application.ScreenUpdating = True
MsgBox "Toplayarak aktarma tamamlandı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub

 

[Korhan Ayhan]

Selamlar,

Problem boş satırlardan kaynaklanıyor.

"rs.Open" ile başlayan sorgu satırını aşağıdaki şekilde değiştirip denermisiniz.

rs.Open ("Select first(F1),first(F2),first(F3),first(F4),first(F5),first(f6),count (F2) from [veri1$B2:H65536] [COLOR=red]where not (f2) is null[/COLOR] group by F2;"), conn, 1, 3

 

[m.gur]

Çok teşekkür ederim. Sorunsuz çalışıyor.