Ağ üzerinde paylaşılan Excel Dosyasına veri kopyalama Hk.

[RamazanCager]

Merhaba Arkadaşlar;

Ağ üzerinde birden fazla kişi tarafından ortak kullanılan paylaştırılmış bir dosyam var. Bu dosyada düğme ile çalışan "Güncelle (son değişiklikler için save yapıyor)," "Otomatik filtre Çözme" ve "Son satıra Git" gibi makrolar var. Bu dosya paylaştırılmış olduğu için diğer kullanıcılar tarafından açık olabilmektedir.
Benim kod ile yaptırmak istediğim, bilgisayarımda herhangi bir yerde bulunan çalışma dosyasındaki TAKİP isimli sayfasının B3:K3 aralığına yazdığım verilerin, Ortak ağ üzerinde Y:\DOĞRUDAN TEMİN_RAMAZAN\TEST yolunda bulunan TAKİP.xlsm adlı dosyadaki TAKİP isimli sayfasının B sütununun son dolu satırının altındaki satıra SADECE DEĞERLER olacak şekilde kopyalamak istiyorum. Ben aşağıdaki kodu yazdım ama son satıra yapıştırma özelliğini yapamadım. Makroda belirtilen hücreye kopyalama yapıyor.. Bu makrodaki kopyalama işleminden önce ağdaki dosyada kaydet işlevini yapması da lazım. Diğer kullanıcıların değişiklikleri işlensin diye. Bu işlem için nasıl bir kod yazılması gerektiğine ilişkin yardımcı olabilirseniz sevinirim.

Mevcut kullandığım kod.

Sub Veri_Transfer()
Application.ScreenUpdating = False
Sheets("TAKİP").Range("B3:K3").Copy
Workbooks.Open("Y:\DOĞRUDAN TEMİN_RAMAZAN\TEST\TAKİP.XLSM").Sheets("TAKİP").Range("B54").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[RamazanCager]

Merhabalar, ben dosyadan dosyaya veri aktarımıni forumdaki https://www.excel.web.tr/threads/kapali-dosyaya-veri-aktarma-kuralli.186608/
Sayfasından ham kodu kullanarak yaptım. Ancak bu kod hedef sayfanın son satırına verileri kopyaliyor. Bu kod işimi görüyor. Ancak benim ihtiyac duyduğum buna benzer bir kod daha var. Şu şekilde
Veri aktarma kodu ile Kaynak dosyadaki sayfa2 nin B3:K:3 aralığındaki veriyi hedef dosyada belirtilen sayfanın son satırına kopyalıyorum. Ancak ilk etapta bu aralikta tüm veriler girilmemiş durumdadir. Bazı hücrelere henüz veri girilmemistir. Bu boş hücrelere belirli bir zaman sonra veri girişi yapıldıktan sonra, tekrar veri kopyalama kodunu calistirdigim zaman yine kaynak dosyada sayfa2 deki B3:K3 hücresinde bulunan verileri, kaynak dosyada sayfa1 deki A1 hücresinde yazılı olan verinin referans alınarak bu veriyi hedef dosyada belirtilen sayfadaki B sütununda arayarak bu verinin olduğu hücreye kopyalamak istiyorum. Bir nevi daha önceden aktarılan verinin güncellenmesi gibi birşey olacak. Yani ikinci defa yapacağım kopyalamanin son satira olmamasi gerekiyor.
Yardımcı olursanız sevinirim

 

[Korhan Ayhan]

Orada kullanılan son satır kodu aşağıdaki gibidir.

Hedef_Son_Satir = Hedef_Sayfa.Cells(Hedef_Sayfa.Rows.Count, 1).End(3).Row + 1

Bu satır yerine BUL (CTRL+F) kullanılabilir. Aşağıdaki yapıyı kodlarınıza uyarlayabilirsiniz.

Set Bul = Hedef_Sayfa.Range("B:B").Find(Kaynak_Sayfa.Range("A1"), xlWhole)
If Not Bul Is Nothing Then
Hedef_Son_Satir = Bul.Row
End If

 

[RamazanCager]

Korhan bey çok teşekkür ederim. Yazdığınız bul kodunu bendeki veri aktarım koduna uyarladım. başta sorun verdi. Biraz değişiklik yapınca sorun çözüldü. Hata veren kısım Find(Aranan, xlWhole) komutu idi. ben bunu Find(Aranan, lookat:=xlWhole) yapınca düzeldi.

kodu başka arkadaşlara lazım olur diye aşağıda paylaşıyorum.

Option Explicit

Sub Verileri_Aktar()
Dim Kaynak_Kitap As Workbook, Kaynak_Sayfa As Worksheet
Dim Hedef_Kitap As Workbook, Hedef_Sayfa As Worksheet
Dim Yol As String, Dosya_Adi As String, Aranan As String
Dim Kaynak_Son_Satir As Long, Hedef_Son_Satir As Long
Dim bul As Range


Application.ScreenUpdating = False

Set Kaynak_Kitap = ThisWorkbook
Set Kaynak_Sayfa = Kaynak_Kitap.Sheets("TAKİP")

Kaynak_Son_Satir = Kaynak_Sayfa.Cells(Kaynak_Sayfa.Rows.Count, 1).End(3).Row + 1

Yol = "d:\"
Dosya_Adi = "DOSYA ADI.XLSM"
Aranan = Kaynak_Sayfa.Range("c3")

Set Hedef_Kitap = Workbooks.Open(Yol & Dosya_Adi, False, False)
Set Hedef_Sayfa = Hedef_Kitap.Sheets("TAKİP")

Set bul = Hedef_Sayfa.Range("C:C").Find(Aranan, lookat:=xlWhole)
If Not bul Is Nothing Then
Hedef_Son_Satir = bul.Row
End If

Kaynak_Sayfa.Range("B3:K" & Kaynak_Son_Satir).Copy Hedef_Sayfa.Range("B" & Hedef_Son_Satir)

Hedef_Kitap.Close True

Application.ScreenUpdating = True

MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Evet haklısınız..

Örnek dosya olmayınca afaki olarak kodu yazmıştım. Aradaki ince detayda gözümden kaçmış. Neyse siz doğrusunu bulmuşsunuz.