Soru Kaynak.xlsm dosyasından Hedef.xlsm dosyasına Veri aktar

[u.L.a.s]

Merhabalar

aşağıdaki linkte Kaynak.xlsm dosyasında gerekli açıklamaları yaptım.

Ama yine de burada detaylı bir şekilde anlatmak gerekirse

Kaynak.xlsm ve Hedef.xlsm diye iki dosyam var.

Kaynak.xlsm dosyamdaki Veriler sayfasında B sütunu makromun işleyeceği yer olacak

B sütununda hangi hücre üstündeysem çalıştıracağım makro ile o hücrenin bulunduğu satırdaki A,B,C,D,E,F sütunlarında bulunan hücrelerdeki verileri birevir Hedef.xlsm dosyasında Liste sayfasına sıradaki boş satıra yapıştırsın istiyorum. ilgili satırdaki veriler geldikten sonra Hedef.xlsm dosyasında Liste sayfasında ilgili satırın G sütunundaki ilgili hücresine ise "Aktif" diye bir veri yazsın istiyorum.

Bilgi ve yardımlarınızı rica ederim

İndir ornek

Dosyayı indir ornek

dosya.co

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu Kaynak dosyası Veriler sayfasının kod bölümüne kopyalayıp deneyiniz. (Hedef dosyasının da açık olması gerek)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Then Exit Sub
Cancel = True
Set s1 = ActiveSheet
Set s2 = Workbooks("Hedef.xlsm").Sheets("Liste")
son = s2.Cells(Rows.Count, 2).End(3).Row + 1
s2.Cells(son, 1).Resize(1, 6).Value = Target.Offset(0, -1).Resize(1, 6).Value
s2.Cells(son, "G") = "Aktif"
End Sub

 

[u.L.a.s]

Çok Teşekkürler Üstadım

Çok ufak bir detay soracağım. Bu makro çift tıklama ile çalışıyor ya

Ben bunu ayrı bir modül içerisinde bir sub altında yazıp Ribbon üstünde oluşturduğum bir butona bu makroyu atadığımda ve bu butona bastığımda

"If Target.Column <> 2 Then Exit Sub" satırı hata veriyor.

Sanırım çift tıklamaya göre olan bu makro ayrı bir modülde bir sub altında çalışmıyor. kodda bir değişiklik yapılması gerekiyor.

Sadece merak ettiğim ve öğrenmek istediğim için soruyorum bunu yoksa bu kodla da işimi hallediyorum.

Ayrı bir modül içerisine yazmış olsaydım bu kodun revize edilmiş hali nasıl olurdu bilgilerinizi rica ederim.

 

[muzaffer.sm]

Sabitleşmiş bir Alternatif bir kod.
Aksine hedef dosyasına yapıştırın bunu.

Hedef dosyasında modüle ekleyin.Deneme yapın.Çalıştırdığınız zaman msoFileDialogOpen yöntemi ile açılacak klasörden kaynak adlı dosyayı içinde kaynak hücreleri seçin hedef dosyasına yapıştırın.


Sub From_Close_Workbook()

'
Dim xWb As Workbook
Dim xBook As Workbook
Dim xRang1 As Range
Dim xRang2 As Range
Set xWb = Application.ActiveWorkbook
Başlık = "Excelden Excele"
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Application.Workbooks.Open .SelectedItems(1)
Set xBook = Application.ActiveWorkbook
Set xRang1 = Application.InputBox(prompt:="Kaynağı Seç", Title:=Başlık, Default:="A1", Type:=8)
xWb.Activate
Set xRang2 = Application.InputBox(prompt:="Hedefi Seç", Title:=Başlık, Default:="A1", Type:=8)
xRang1.Copy xRang2
xRang2.CurrentRegion.EntireColumn.AutoFit
xBook.Close False
End If
End With
End Sub

 

[ÖmerBey]

"If Target.Column <> 2 Then Exit Sub" satırı hata veriyor.

Kod çift tık tetikleme ile çalıştığı için buradaki target çift tıklanılan hücre demek oluyor. Siz bunu başka bir sub içerisinde kullanmak istediğiniz zaman target ifadesini tanımlamanız gerekecektir.

Ayrı bir modül içerisine yazmış olsaydım bu kodun revize edilmiş hali nasıl olurdu bilgilerinizi rica ederim.

Mevcut koda çift tıklama yapılan satırı kopyala diyoruz, o da işini yapıyor. Ayrı bir modüle yazılan kod; neye göre kopyalama yapılacak, hangi satrırlar kopyalanacak... gibi soruların cevabına göre değişiklik göstecektir.

 

[u.L.a.s]

Üstadım işte bu durumda nasıl revize etmek gerekecek.

Ben Kaynak.xlsm dosyamda ilgili sayfada aktaracağım satır hangisi ise o satırda b sütununda ilgili hücrede olunca tetikleyecek bir makro nasıl olabilir

Örneğin aşağıdaki makro düzeneğinde aynı excel kitabında bir sayfadan diğer sayfaya A sütununda hangi hücrede isem ilgili satırı diğer sayfaya aktarıyor.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Tesisler")
    Set S2 = Sheets("İptaller")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        S1.Range("A" & ActiveCell.Row & ":AL" & ActiveCell.Row).Copy S2.Range("C" & Son)
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[u.L.a.s]

Merhabalar

Aslında benim "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" kodu altında cok fazla "If Target.Column = x" kodu var. sizin ilettiğiniz kodu ben en başa koyunca bu sefer diğer if target kodları ile başlayanlar çalışmıyordu.

Ben sizin gönderdiğiniz kod düzeneğinde "If Target.Column <> 2 Then Exit Sub" satırını "If Target.Column = 2 Then " ile değiştirip End If ile kapattım. böylelikle sorun düzelmiş oldu

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then
Cancel = True
Set s1 = ActiveSheet
Set s2 = Workbooks("Hedef.xlsm").Sheets("Liste")
son = s2.Cells(Rows.Count, 2).End(3).Row + 1
s2.Cells(son, 1).Resize(1, 6).Value = Target.Offset(0, -1).Resize(1, 6).Value
s2.Cells(son, "G") = "Aktif"
End If
End Sub

 

[ÖmerBey]

Buna çok sevindim, iyi çalışmalar diliyorum...

 

[Korhan Ayhan]

Genel olarak birkaç ek bilgi;

Sayfaların ya da kitabın kod bölümüne yazılan kodları alıp direkt modül içinde kullanamazsınız. Düzenlenmesi gerekebilir.

Soru sorarken sayfaların kod bölümünde başka kodlar olduğunu bildirmekte fayda var. Aksi durumda cevap verenler bunu bilemezler.