İçerikleri tek sayfada birleştirmek.

[harakikiri]

Merhaba,
Örnek dosyada görüldüğü gibi, bir MERKEZ ve NOKTA1, NOKTA2, NOKTA3,....... şeklinde sayfalar var. Ürün stok kodları ve isimleri aynı ama sıralaması ile adetleri farklı. Merkez sayfası tüm ürünleri kapsadığı için referans sayfa kabul edilebilir.
Yapmayı istediğim çalışma; Nokta1, nokta2... gibi değişken sayıda ve değişken isimlerdeki sayfaların "Net Satılan Miktar" ve "K.D.V. dahil Net Satış Değer" lerini doğru yerlerine yazdırmak.

Bu konuda yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.

 

[Orion1]

Doğru yerleri neresi,yanlış yerleri neresi.
Bir örnekle açıklayınız?

 

[harakikiri]

Doğru yerleri neresi,yanlış yerleri neresi.
Bir örnekle açıklayınız?

Aslında örnek incelendiğinde açıklamaya gerek kalmadan anlaşılabileceğini düşünüyorum ama kısaca özetlemek gerekirse..

Nokta1 sayfasındaki "002079" stok kodlu "detan sinekkıran" değerleri olan 2C hücresindeki "3" değeri ve 2D hücresindeki "11,25" değeri, MERKEZ sayfasında ki 3E ve 3F hücrelerinde görüntülenmeliler.

İlk bir kaçtanesini elle yaparak kırmızı işaretledim örnek açısından..

 

[Orion1]

Dosyanız ekte.
A sütunlarındaki kod nolara göre tarıyor.

Sub sayfalari_aktar()
Dim sh As Worksheet, j As Integer, sat As Long, k As Range, sh1 As Worksheet
Dim sat2 As Long, i As Long
Set sh1 = Sheets("MERKEZ")
Application.ScreenUpdating = False
sh1.Range("C3:IV65536").ClearContents
sat = sh1.Cells(65536, "A").End(xlUp).Row
For Each sh In Worksheets
    If UCase(sh.Name) <> "MERKEZ" Then
        For j = 5 To 256 Step 2
            If sh1.Cells(1, j).Value = sh.Name Then
                sat2 = sh.Cells(65536, "A").End(xlUp).Row
                For i = 2 To sat2
                    Set k = sh1.Range("A3:A" & sat).Find(sh.Cells(i, "A").Value, , xlValues, xlWhole)
                    If Not k Is Nothing Then
                        sh1.Cells(k.Row, j).Value = sh.Cells(i, "C").Value
                        sh1.Cells(k.Row, j + 1).Value = sh.Cells(i, "D").Value
                    End If
                Next i
                Exit For
            End If
        Next j
    End If
Next sh
Application.ScreenUpdating = True
MsgBox "Aktarma işlemi tamamlandı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[harakikiri]

Evren Gizlen arkadaşım yanıtım biraz gecikti ama, süratli ve başarılı çözümünüz için çok teşekkür ediyorum, biraz müdehale ile tam da istediğim gibi oldu.