kapalı dosyadan aktarma yardım

[asilme]

arkadaşlar elimde daha önce siteden aldığım bir kod var ve bu kodda

açık olan dosyaya getirip ilk olarak yapıştırdığı yer 2.satır ben bunu 5.satırdan başlamak istiyorum kodun neresini değiştirmeliyim.ayrıca aldığım dosya ve sayfa adını değiştirmek istiyorum nerelerini değiştirmem gerekiyor kod üzerinde gösterebilirmisiniz kod çalışıyor sadece başka bir dosyaya uyarlamaya çalışıyorum hata veriyor yardım edermisiniz

kod aşağıdaki gibi


Private Sub CommandButton1_Click()
Dim con As Object, rs As Object
Dim sorgu As String, dosya As String
If ListBox1.ListIndex = -1 Then MsgBox "Dosya Seçimi Yapmadınız", _
vbCritical + vbMsgBoxRtlReading, "U Y A R I": Exit Sub
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordSet")
ListBox2.Clear
dosya = ListBox1.Value
con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
ThisWorkbook.Path & "\" & dosya & ";Extended Properties=""Excel 12.0;hdr=no"""
ListBox2.Clear
isim = Array(" tut", " mev")
For a = 0 To 1
sorgu = "Select * FROM [" & Replace(ListBox1.Value, ".xlsm", "") & isim(a) & "$A5:H10000] where not isnull(f1)"
rs.Open sorgu, con, 1, 1
Do Until rs.EOF
ListBox2.ColumnCount = 8
ListBox2.ColumnWidths = 50
ListBox2.AddItem rs(0).Value
ListBox2.List(ListBox2.ListCount - 1, 1) = rs(1).Value
ListBox2.List(ListBox2.ListCount - 1, 2) = rs(2).Value
ListBox2.List(ListBox2.ListCount - 1, 3) = rs(3).Value
ListBox2.List(ListBox2.ListCount - 1, 4) = rs(4).Value
ListBox2.List(ListBox2.ListCount - 1, 5) = rs(5).Value
ListBox2.List(ListBox2.ListCount - 1, 6) = rs(6).Value
ListBox2.List(ListBox2.ListCount - 1, 7) = rs(7).Value
rs.MoveNext
Loop
If MsgBox("? Veriler Aktarılsın mı", vbInformation + _
vbMsgBoxRtlReading + vbYesNo, "Aktarmadan Önceki Son Çıkış") = vbNo Then
MsgBox "Aktarım İptal Edildi", vbExclamation + vbMsgBoxRtlReading, "Son Durum": ListBox2.Clear: Exit Sub
Else
sayfa = Replace(ListBox1.Value, ".xlsm", "") & isim(a)
Sheets(sayfa).Select
Dim Satir As Integer, Sutun As Integer
Satir = UBound(ListBox2.List, 1)
Sutun = UBound(ListBox2.List, 2)
Range(Cells(2, 1), Cells(2 + Satir, 1 + Sutun)).Value = ListBox2.List
End If
ListBox2.Clear
rs.Close
Next a
con.Close
Set con = Nothing: Set rs = Nothing: dosya = vbNullString
End Sub

Private Sub UserForm_Initialize()
For i = 2 To Sayfa2.Range("Z65536").End(3).Row
ListBox1.AddItem Sayfa2.Cells(i, "Z")
Next i
ListBox2.Height = ListBox1.Height
End Sub


ve userformun kodunda çalışıyor

 

[asilme]

arkadaşlar herhalde sorumu tam anlatamadım cevap yazan olmamış buton ile getirdiğim sayfada 2.satırdan itibaren yapıştıran bu formülü 5.satırdan itibaren nasıl yapıştırabilirim bilen varsa lütfen yardım edermisiniz

 

[Korhan Ayhan]

Merhaba,

Vba ile ilgilenen bir kişinin artık bu değişiklikleri rahatlıkla uygulayabilmesi gerektiğini düşünüyorum.

Aşağıdaki satırdaki 2 leri 5 ile değiştirip deneyiniz.

Range(Cells(2, 1), Cells(2 + Satir, 1 + Sutun)).Value = ListBox2.List

 

[asilme]

teşekkürler hocam kolay gelsin