Makro ile özel kopyalama

[recepali08]

Merhaba,
Ekteki dosyada "Veriler" sayfasında C2-C12 arasında başka dosyadan aktardığım veriler olacak. Benim sorunum bu verileri "Tablo-1","Tablo-2" ve "Tablo 3"teki ilgili yerlerine göndermek. Görüldüğü üzere "Kod" verisi her üç tabloda da mevcut ve buralara gönderilmesi gerek. Eğer "Güncelle" butonuna bastığımda ilgili verilerin yerine gönderilmesi ve sonrasında alanın temizlenmesi şeklinde bir çözüm bulabilirsek sorun çözülmüş olacak. Şimdiden ilgilenen arkadaşlara, abilerime teşekkür ederim.

Not: Asıl çalıştığım tablolar yaklaşık biner satır ve elli sütun genişliğinde ancak mantığı anlayınca kalanı tamamlayabilirim diye düşünüyorum. İsteyen kişiler kodlara açıklama girebilir.

Dosyayı mesaja ekleyemedim,
link:http://s3.dosya.tc/server10/qxurg1/deneme.rar.html

 

[dEdE]

Merhaba,
Forumumuza hoş geldiniz.
Aşağıdaki kodları örnek dosyanızda dener misiniz?

Sub Yerleştir()
Set v = Sheets("Veriler")
For i = 1 To Worksheets.Count - 1
    Bulunacak = Sheets("Veriler").Cells(2, 2).Value
    Set Aranan = Sheets(i).Range("B:B").Find(Bulunacak, , xlValues, xlWhole)
    If Not Aranan Is Nothing Then
        If Sheets(i).Name = "Tablo-1" Then
            Sheets(i).Range(Aranan.Address).Offset(0, 1) = v.Cells(3, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 2) = v.Cells(5, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 3) = v.Cells(6, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 4) = v.Cells(4, 2)
        ElseIf Sheets(i).Name = "Tablo-2" Then
            Sheets(i).Range(Aranan.Address).Offset(0, 1) = v.Cells(3, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 2) = v.Cells(7, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 3) = v.Cells(8, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 4) = v.Cells(9, 2)
        Else
            Sheets(i).Range(Aranan.Address).Offset(0, 1) = v.Cells(3, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 2) = v.Cells(10, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 3) = v.Cells(11, 2)
            Sheets(i).Range(Aranan.Address).Offset(0, 4) = v.Cells(12, 2)
        End If
    End If
Next i
v.Range("B2:B12").ClearContents
MsgBox "Güncelleme İşlemi Tamamlandı. ", vbInformation, "dEdE  " & _
Application.UserName & "'e Başarılar Diler."
End Sub

 

[recepali08]

Merhabalar,

Çok teşekkür ederim, tam istediğim gibi olmuş. Gerisini hallederim artık.

Elinize sağlık.