kodda çözemediği yer

[karakaçan]

İyi akşamlar arkadaşlar. Bir dosyadan aşağıdaki kod ile veri çekmek istiyorum. Ancak her bir veri için tek tek dosya seçmemi istiyor. Halbuki dosya aynı tek bir dosya. Nasıl düzenleyebiliriz bu kodu?

Option Explicit

Sub VERİ_AL()
Dim Satır As Long, Sütun As Byte, Son_Satır As Long, Son_Sütun As Byte

Son_Satır = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!C1)")
Son_Sütun = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!R1)")

Range(Cells(1, 1), Cells(Son_Satır, Son_Sütun)).ClearContents

For Satır = 1 To Son_Satır
For Sütun = 1 To Son_Sütun
Cells(Satır, Sütun) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!R" & Satır & "C" & Sütun & "")
Next
Next

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Haluk]

Verilerin çekildiği "Kitap1.xls" dosyasının, kodun çalıştırıldığı Excel dosyası ile aynı klasörde olması gerekir...

.

 

[karakaçan]

Verilerin çekildiği "Kitap1.xls" dosyasının, kodun çalıştırıldığı Excel dosyası ile aynı klasörde olması gerekir...

.

İkisi de aynı klasörde duruyor. ondan yana sıkıntı yok. Sorun veri çekeceğimiz dosyada 10 tane hücrede veri varsa dosya yolunu 10 defa soruyor. Bir kere sorup geçsin.

 

[karakaçan]

İkisi de aynı klasörde duruyor. ondan yana sıkıntı yok. Sorun veri çekeceğimiz dosyada 10 tane hücrede veri varsa dosya yolunu 10 defa soruyor. Bir kere sorup geçsin.

Müsait olan birisi bakabilir mi?

 

[Haluk]

Verileri alacağınız dosyanın adı Kitap1.xls ve sayfanın adı Sayfa1 ise, sorun olmaması gerekir.

.

 

[karakaçan]

Verileri alacağınız dosyanın adı Kitap1.xls ve sayfanın adı Sayfa1 ise, sorun olmaması gerekir.

.
[/Q
her şeyi yapmama rağmen aynı sorun devam ediyor. Kaç tane veri varsa her seferinde dosya seçmemi istiyor.

 

[Haluk]

Son tahminim, veri aldığınız dosya ile ilgili.....

Söz konusu Kitap1.xls dosyasını xlsx olarak kaydedip, kodu tekrar dener misiniz ?

Aşağıdaki kodda görüldüğü gibi, orjinal kodlarınızdaki Kitap1.xls yerine Kitap1.xlsx olarak değiştirin....

Sub VERİ_AL()
Dim Satır As Long, Sütun As Byte, Son_Satır As Long, Son_Sütun As Byte

Son_Satır = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!C1)")
Son_Sütun = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!R1)")

Range(Cells(1, 1), Cells(Son_Satır, Son_Sütun)).ClearContents

For Satır = 1 To Son_Satır
For Sütun = 1 To Son_Sütun
Cells(Satır, Sütun) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!R" & Satır & "C" & Sütun & "")
Next
Next

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

.

 

[karakaçan]

Son tahminim, veri aldığınız dosya ile ilgili.....

Söz konusu Kitap1.xls dosyasını xlsx olarak kaydedip, kodu tekrar dener misiniz ?

Aşağıdaki kodda görüldüğü gibi, orjinal kodlarınızdaki Kitap1.xls yerine Kitap1.xlsx olarak değiştirin....

Sub VERİ_AL()
Dim Satır As Long, Sütun As Byte, Son_Satır As Long, Son_Sütun As Byte

Son_Satır = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!C1)")
Son_Sütun = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!R1)")

Range(Cells(1, 1), Cells(Son_Satır, Son_Sütun)).ClearContents

For Satır = 1 To Son_Satır
For Sütun = 1 To Son_Sütun
Cells(Satır, Sütun) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kitap1.xlsx]Sayfa1'!R" & Satır & "C" & Sütun & "")
Next
Next

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

.

Çok teşekkürler sağolun.