Sayfalar arası kopyalama makrosu

[wave41]

ekteki dosyada FIYATLAR sekmesinde FIYATLAR_ID yi kopyalayıp YAZILAR sekmesinde YAZILAR_ID de bulup buradan ADI,CINSI ve MIKTAR bilgilerini kopyalayarak FIYATLAR sekmesindeki ilgili yerleri doldurmasını istiyorum.yardımcı olacaklara şimdiden teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Sub fiyatlar59()
Dim i  As Long, sat1 As Long, sat2 As Long
Dim adrs As String, sh As Worksheet, k As Range
Sheets("FIYATLAR").Select
Range("B2:D" & Rows.Count).Clear
sat1 = Cells(Rows.Count, "A").End(xlUp).Row
If sat1 < 2 Then
    MsgBox "Fiyatlar sayfasında veri yok.!" & vbLf & "İşlem İptal oldu", vbCritical, "U Y A R I"
    Exit Sub
End If
Set sh = Sheets("YAZILAR")
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
If sat2 < 2 Then
    MsgBox "YAZILAR Sayfasında veri yok !!" & vbLf & "İşlem İptal oldu", vbCritical, "U Y A R I"
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 2 To sat2
    Set k = sh.Range("A2:A" & sat2).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("B" & i & ":D" & i).Value = sh.Range("B" & k.Row & ":D" & k.Row).Value
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

End Sub

 

[dEdE]

Merhaba,
Alternatif bir kod da benden olsun.

Sub BulGetir()
On Error Resume Next
Set S1 = Sheets("YAZILAR")
Set S2 = Sheets("FIYATLAR")

For i = 2 To S2.[A65536].End(3).Row
    With WorksheetFunction
        If .CountIf(S1.Range("A:A"), S2.Cells(i, 1).Value) > 0 Then
            S2.Cells(i, 2).Value = .VLookup(S2.Cells(i, 1).Value, S1.Range("A:D"), 2, 0)
            S2.Cells(i, 3).Value = .VLookup(S2.Cells(i, 1).Value, S1.Range("A:D"), 3, 0)
            S2.Cells(i, 4).Value = .VLookup(S2.Cells(i, 1).Value, S1.Range("A:D"), 4, 0)
        End If
    End With
Next
MsgBox "İşlem tamamlandı.", vbInformation, Application.UserName
End Sub

 

[Filose]

Merhaba Orion;
Forumda sorunumu yazdım ama, sizi görünce sorunumu sizede iletmek istedim.

2 Adet açık dosyam var. 1. si Mizan bundan 2. dosyama veri almak istiyorum.

1. açık olan dosyadan (Mizan) Örn: "ALICILAR" hücresini bulup 2,3 veya 4 sütün sonra bulunan hücrenin bilgisini alıp yine açık olan 2. dosyanın A10 hücresine yazsın.
Düşeyara komudunda olduğu gibi. Önce araran hesap no veya hesap adını bulup aynı satırın istenilen sutunundan bilgiyi alıp 2. açık olan dosyanın
A10 hücresine yazsın.
Not: Aranacak Hesap Adı veya Hesap Kodu makronun içinde olabilir.

Şimdiden teşekkürler.

 

[wave41]

İlginiz için teşekkür ederim.Makrolar çalışıyor fakat fiyatlar sekmesinde aynı FIYATLAR_ID bazen 10 kez yazılmış olabiliyor.Bu işlemi hepsi için aynı şekilde yapmasını istiyorum.Vermiş olduğunuz örnekte her FIYATLAR_ID için sadece 1 kez yapıyor .2 kez Aynı FIYATLAR_ıd için aynı işlemi yapmıyor.

 

[wave41]

Sorun YAZILAR sekmesindeki satır sayısı kadar işlem yapmasıymış.YAZILAR sekmesinde 1000 Satır varken FIYATLAR sekmesinde 10000 SATIR varsa sadece ilk 1000 satıra bu işlemi yapıyor.

 

[dEdE]

Sorun YAZILAR sekmesindeki satır sayısı kadar işlem yapmasıymış.YAZILAR sekmesinde 1000 Satır varken FIYATLAR sekmesinde 10000 SATIR varsa sadece ilk 1000 satıra bu işlemi yapıyor.

Merhaba,
3. mesajdaki kodları denediniz mi? Fiyatlar sekmesinde kaç satır varsa tamamı için işlem yapar.

FIYATLAR_ID bazen 10 kez yazılmış

ise on kez işlem yapar.

 

[wave41]

Teşekkürler.