Kapalı Dosyadan Veri Alma

[ankidod]

Arkadaşlar merhaba. Kapalı excel dosyasından Açık excel dosyasının sayfa2'sindeki tabloya veri almaya çalışıyorum. Kapalı excel dosyasının formatı ekteki gibi. Renkli olarak belirttiğim sütunları kopyalamanın bir yolu var mı acaba? Bu arada Kapalı dosyasında ki bu veriler bazen 30 satır bazen 1 satır olabilir. Son olarakta bu aktarma işlemi bittikten sonra Kapalı dosyası silinebilir mi ve eğer dosya yoksa uyarı verebilir mi? Teşekkürler şimdiden. Son halinin aşağıdaki gibi olmasını istiyorum mümkünse.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
Dim Con As Object, Rs As Object, Sorgu As String, i As Integer
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")

If Dir(ThisWorkbook.Path & "\Kapalı.xlsx") = "" Then
MsgBox "Kapalı Tablosu Yok", vbCritical
Exit Sub
Else

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.Path & "\Kapalı.xlsx" & ";extended properties=""excel 12.0;hdr=yes"""

Sorgu = "Select * from [Kapalı$]"
Rs.Open Sorgu, Con, 3, 1
Range("B1").CopyFromRecordset Rs

Con.Close
Set Con = Nothing: Set Rs = Nothing: Sorgu = "": i = Empty

Kill ThisWorkbook.Path & "\Kapalı.xlsx"

End If
End Sub

. . .

 

[ankidod]

Hocam teşekkürler. Veriyi tam istediğim gibi alıyor. Fakat şöyle bir sıkıntıyla karşılaştım. Acaba sorun nedir? Tabloyu genişletmiyor. Bir de kodları .xlsx ile olduğu gibi .xls ile de uyumlu hale getirebilir miyiz?

 

[Emir Hüseyin Çoban]

. . .

Kill satırından önce şu kodları ekleyin.

son = [B65536].End(3).Row + 1
ActiveSheet.ListObjects("Tablo1").Resize Range("$A$1:$M$" & son)

. . .

 

[ankidod]

Hocam uzantı ile ilgili sorumu sanırım siz baktıktan sonra ekledim. Kodları .xlsx ile olduğu gibi .xls ile de uyumlu hale getirebilir miyiz?

 

[ankidod]

Hocam başınızı ağrıttım ama son verdiğiniz kodu denedim şöyle bir şey çıktı bu seferde. Satırın birini toplam satırına atıyor.

 

[Murat OSMA]

Sayfadaki tabloyu silerseniz sorun kalmaz.

 

[ankidod]

Murat Bey denedim. Malesef olmuyor. Ya da yanlış yaptığım birşeyler var. Satırın biri kayboluyor bu seferde. Şöyle bir şey denedim;
Sonuç Ekran Alıntısında.

Sub KOD()

sonsatır = [A65536].End(3).Row + 1
Range("A2:M" & sonsatır).EntireRow.Delete

Dim Con As Object, Rs As Object, Sorgu As String, i As Integer
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")

If Dir(ThisWorkbook.Path & "\Kapalı.xlsx") = "" Then
MsgBox "Kapalı Tablosu Yok", vbCritical
Exit Sub
Else

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.Path & "\Kapalı.xlsx" & ";extended properties=""excel 12.0;hdr=yes"""

Sorgu = "Select * from [Kapalı$]"
Rs.Open Sorgu, Con, 3, 1
Range("B1").CopyFromRecordset Rs

Con.Close
Set Con = Nothing: Set Rs = Nothing: Sorgu = "": i = Empty

son = [B65536].End(3).Row + 1
ActiveSheet.ListObjects("Tablo1").Resize Range("$A$1:$M$" & son)

Kill ThisWorkbook.Path & "\Kapalı.xlsx"

End If
End Sub

 

[Murat OSMA]

Tabloyu silin demiştim silmemişsiniz. Söylediğim yapılmadığı zaman ilgilenmek içimden gelmiyor.

 

[ankidod]

... Ya da yanlış yaptığım birşeyler var. ...

Bu cümleden ne anlıyorsunuz? Ben satırları sil anlamışım. Ayrıca tabloyu tamamen silmek istediğim şeyle örtüşmüyor. Bilginize, emeğinize yaptıklarınıza son derece saygım var. Hitap ederken ve düşünürken buna özen göstermeye çalışıyorum. Ama tavrınız hoş değildi. Neyse. Bu da eksik olsun. Bu sitenin ve sizlerin hakkı çok. Saygı duyuyorum. Kolay gelsin.

 

[Murat OSMA]

Ben o cümleden önceki cümleye bakarım.
Sayfadaki tabloyu silin sorun kalmaz dedim. Bunda anlaşılmayacak ya da yanlış anlayacak ne var ? :dusun: Ayrıca anlaşılmayacak uzun bir cümle de kurmadım, bu kısacık cümleyi nasıl yanlış anlıyorsunuz hayret !? :dusun:
Söylediğimi yaptıktan sonra olmadı deseydiniz, ben size olana kadar yardımcı olurdum. Ama böyle olunca, dediğim gibi canım sıkılıyor ve ilgilenmek içimden gelmiyor...



Bu tavrım hoş değil demek... :dusun:

Tabloyu silin demiştim silmemişsiniz. Söylediğim yapılmadığı zaman ilgilenmek içimden gelmiyor.

Hislerimi, düşüncelerimi dile getirmek bile hoş karşılanmıyor oldu artık. Nereye doğru gidiyoruz bilmiyorum, Allah sonumuzu hayır etsin ne diyeyim.


İyi akşamlar.

 

[ankidod]

Haklısınız. Kusuruma bakmayın.

 

[Emir Hüseyin Çoban]

. . .

Açık kitabında Tablo tasarımını kullanmanız gerekli mi?

. . .

 

[irfancantr]

. . .

Sub KOD()
Dim Con As Object, Rs As Object, Sorgu As String, i As Integer
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")

If Dir(ThisWorkbook.Path & "\Kapalı.xlsx") = "" Then
MsgBox "Kapalı Tablosu Yok", vbCritical
Exit Sub
Else

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.Path & "\Kapalı.xlsx" & ";extended properties=""excel 12.0;hdr=yes"""

Sorgu = "Select * from [Kapalı$]"
Rs.Open Sorgu, Con, 3, 1
Range("B1").CopyFromRecordset Rs

Con.Close
Set Con = Nothing: Set Rs = Nothing: Sorgu = "": i = Empty

Kill ThisWorkbook.Path & "\Kapalı.xlsx"

End If
End Sub

. . .

Gayet güzel olmuş Hüseyin bey,

Peki tam tersini düşünürsek, sayfada ki tüm verileri olduğu gibiaçık dosyadan kapalıya göndermek istersek kodlarda ki değişiklik ne gibi olmalı?

Teşekkürler.