Dosyalar arası veri aktarımı

[gezin23]

Herkese iyi akşamlar.
Buton yardımıyla dosyalar arası veri aktarımı yapmam gerekiyor.
Gerekli açıklamaları eklediğim dosya üzerinde yaptım. Zaman Ayırıp ilgilenen arkadaşlara şimdiden çok teşekkür ederim.

 

[gezin23]

Bir önceki dosya bozuk olduğundan açmıyor, tekrardan yenisini yükledim.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodları dener misiniz?

Sub KOD()
Set ul = Workbooks("upload.xls").Sheets(1)
Set s1 = ActiveSheet
ul.Range("C2:AG100").ClearContents
For a = 2 To s1.Range("A65500").End(3).Row
    If s1.Cells(a, "A") > 0 Then
        sat = WorksheetFunction.Match(s1.Cells(a, "A"), ul.Range("A:A"), 0)
        For b = 3 To s1.Range("AZ1").End(1).Column
            If Cells(a, b) <> "" Then
                süt = WorksheetFunction.Match("Gun" & Day(s1.Cells(1, b)), ul.Range("1:1"), 0)
                ul.Cells(sat, süt) = s1.Cells(a, b)
            End If
        Next
    End If
Next
End Sub

 

[gezin23]

Sayın Mucit77 öncelikle ilginiz için teşekkür ederim. Dediğiniz kodu uyguladım ama hata verdi. Worksheetfunction sınıfının match özelliği kullanılamıyor. Diye uyarı verdi

 

[ÖmerBey]

Ben de denedim ama ben de hata vermedi.
Ders dosyasındaki butona tıklatınca upload dosyasındaki boşlukları doldurdu.
(Her iki dosyanın da açık oolması gerekli.)
Söylediğiniz hata kimlik numarasını bulamadığı için çıkmış olmalı. Upload dosyasının kullandığınız hali yüklediğiniz örnek dosyalardan farklıysa bu hata oluşmuş olabilir.
Ekteki dosyaları inceleyiniz.

 

[gezin23]

Sayın Mucit haklısınız ben T.C numarasını yazmadım bu yüzden aktarmadı. Tarih kısımları çok iyi olmuş. Yani ayın biri gun1 e denk gelecek şekilde aktarıyor, tam istediğim gibi. Ama ben aktar butonuna basdığımda t.c nosuyla birlikte aktarılmasını istiyorum. Bi de Ders sayfasında boş olan satırların da upload sayfasına atmaması gerekiyor. Uğraştırıyorum kusura bakmayın

 

[ÖmerBey]

Kodu aşağıdakiyle şekilde değiştiriniz.

Sub KOD()
Set ul = Workbooks("upload.xls").Sheets(1)
Set s1 = ActiveSheet
sat = 2
ul.Range("A2:AG100").ClearContents
For a = 2 To s1.Range("A65500").End(3).Row
    If s1.Cells(a, "A") > 0 Then
        ul.Cells(sat, 1) = s1.Cells(a, 1)
        ul.Cells(sat, 2) = s1.Cells(a, 2)
        For b = 3 To s1.Range("AZ1").End(1).Column
            If s1.Cells(a, b) <> "" Then
                süt = WorksheetFunction.Match("Gun" & Day(s1.Cells(1, b)), ul.Range("1:1"), 0)
                ul.Cells(sat, süt) = s1.Cells(a, b)
            End If
        Next
        sat = sat + 1
    End If
Next
End Sub

 

[gezin23]

Çok teşekkür ederim tam istediğim gibi oldu.

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...

 

[gezin23]

İyi akşamlar.
Sayın Mucit77, verdiğiniz kodu eklediğim sayfadan farklı bir sayfaya uyguladığımda type missmatch hatası veriyor. eklediğim Ders dosyası ile aynı içeriğe sahip başka dosyaya uyguladığımda bu hatayı veriyor. Yardımcı olursanız çok sevinirim. Kodları nasıl değiştirebileceğimi söylerseniz inşallah hallederim

 

[gezin23]

Sayın Mucit77 bu konuda yardımcı olabilirseniz çok sevinirim

 

[ÖmerBey]

Uyumsuz veri hatası...
Aşağıdaki satırla alakalı olduğunu tahmin ediyorum. Veri alınan hücrenin tarih olması gerekiyor, başka türden veri olan bir hücreye başvuru yapıyorsa bu hatayı verir.

süt = WorksheetFunction.Match("Gun" & [COLOR="Red"]Day(s1.Cells(1, b))[/COLOR], ul.Range("1:1"), 0)

Burada s1 diye ayarladığımız sayfanın 1. satır b (Döngüyle değişir) sütunundaki verinin gün değeri kullanılıyor.