Birkaç hücresi aynı olan bilgileri başka bir sayfada toplama

[supernatural]

Sheet 1'den sistem bize otomatik olarak pembe ile boyanmış kolonları veriyor.Bu kodlar veriliyor ancak sistem bize bunun hangi depoda olduğunu vermiyor.
Bu yüzden biz başka bir programdan malların hangi depoda olduğunu ayrı bir liste ile alıyoruz yani(sheet 2,3 ve 4).
Ancak biz bu bilgilerin 1 listede toplanmasını istiyoruz.Yani istenilen sayfasında
Eğer Sheet 1'de Kodu,fatura numurası,gönderilecek yer,kırtasiye kodu diğer sheetlerin(sheet 2,3,4) herhangi birinde verilen bilgilerle aynı ise otomatik olarak
deposunu da alıp buraya listelesin.
Eğer sheet 1'de olup diğer sheetlerde yok ise malın bulunduğu yeri 0 olarak göstersin
Turuncu olan yerler Sheet 1 dekiler ile aynı
Ancak Sheet 2,3,4 ile boyanmış yerler bize gerekmiyor ve bu liste de kullanmak istemiyoruz.
Ayrıca N kolonunda bulunan depolarda yukardaki gibi bize sıralı olması lazım.

YARDIMLARINIZ İÇİN SİZE ŞİMDİDEN ÇOK TEŞEKKÜR EDERİM.

 

[Orion1]

Dosyanız ektedir.

Sub karsilastir_aktar()
Sheets("İSTENİLEN").Select
Range("A2:N65536").Clear
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Dim sh1 As Worksheet, j As Long, s As Long
Set sh1 = Worksheets("Sheet1")
sat3 = 2
sat1 = sh1.Cells(65536, "C").End(xlUp).Row
Application.ScreenUpdating = False
For i = 6 To sat1
    Cells(sat3, "A").Value = sh1.Cells(i, "B").Value
    Cells(sat3, "B").Value = sh1.Cells(i, "C").Value
    Cells(sat3, "C").Value = sh1.Cells(i, "D").Value
    Cells(sat3, "H").Value = sh1.Cells(i, "I").Value
    Cells(sat3, "N").Value = 0
    For j = 2 To Worksheets.Count - 1
        sat2 = Sheets(j).Cells(65536, "A").End(xlUp).Row
        For s = 2 To sat2
            If Sheets(j).Cells(s, "A").Value = sh1.Cells(i, "C").Value And _
            Sheets(j).Cells(s, "B").Value = sh1.Cells(i, "D").Value And _
            Sheets(j).Cells(s, "C").Value = sh1.Cells(i, "E").Value And _
            Sheets(j).Cells(s, "L").Value = sh1.Cells(i, "I").Value Then
                Cells(sat3, "N").Value = Sheets(j).Cells(s, "E").Value
                GoTo atla
            End If
        Next s
    Next j
atla:
    sat3 = sat3 + 1
Next i
Range("A2:N" & sat3 - 1).Sort key1:=Range("N2"), key2:=Range("C2"), key3:=Range("A2")
Application.ScreenUpdating = True
MsgBox "Akatrım Tamamlnmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[supernatural]

Dosyanız ektedir.

Sub karsilastir_aktar()
Sheets("İSTENİLEN").Select
Range("A2:N65536").Clear
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Dim sh1 As Worksheet, j As Long, s As Long
Set sh1 = Worksheets("Sheet1")
sat3 = 2
sat1 = sh1.Cells(65536, "C").End(xlUp).Row
Application.ScreenUpdating = False
For i = 6 To sat1
    Cells(sat3, "A").Value = sh1.Cells(i, "B").Value
    Cells(sat3, "B").Value = sh1.Cells(i, "C").Value
    Cells(sat3, "C").Value = sh1.Cells(i, "D").Value
    Cells(sat3, "H").Value = sh1.Cells(i, "I").Value
    Cells(sat3, "N").Value = 0
    For j = 2 To Worksheets.Count - 1
        sat2 = Sheets(j).Cells(65536, "A").End(xlUp).Row
        For s = 2 To sat2
            If Sheets(j).Cells(s, "A").Value = sh1.Cells(i, "C").Value And _
            Sheets(j).Cells(s, "B").Value = sh1.Cells(i, "D").Value And _
            Sheets(j).Cells(s, "C").Value = sh1.Cells(i, "E").Value And _
            Sheets(j).Cells(s, "L").Value = sh1.Cells(i, "I").Value Then
                Cells(sat3, "N").Value = Sheets(j).Cells(s, "E").Value
                GoTo atla
            End If
        Next s
    Next j
atla:
    sat3 = sat3 + 1
Next i
Range("A2:N" & sat3 - 1).Sort key1:=Range("N2"), key2:=Range("C2"), key3:=Range("A2")
Application.ScreenUpdating = True
MsgBox "Akatrım Tamamlnmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Cevap için çok teşekkürler Evren bey ancak burda bir problemimiz var galiba ben eksik yazmışım.Diğer yerler tamam.
Sheet1 deki fatura ve gönderilecek yer,sheet2,3 ve 4 içinde de aynı veriyi bulacak ve malın hangi depoda olduğunu da istenilen de malın bulunduğu yere yazması gerekiyor.Teşekkürler size çok zahmet verdik.

 

[Orion1]

Eğer Sheet 1'de Kodu,fatura numurası,gönderilecek yer,kırtasiye kodu diğer sheetlerin(sheet 2,3,4) herhangi birinde verilen bilgilerle aynı ise otomatik olarak

Cevap için çok teşekkürler Evren bey ancak burda bir problemimiz var galiba ben eksik yazmışım.Diğer yerler tamam.
Sheet1 deki fatura ve gönderilecek yer,sheet2,3 ve 4 içinde de aynı veriyi bulacak ve malın hangi depoda olduğunu da istenilen de malın bulunduğu yere yazması gerekiyor.Teşekkürler size çok zahmet verdik.

Ben yukarıdaki ilk ifanize göre istediğinizin aynisini yaptım.
Orada değişen ne oldu.
Zira son ifadenizde söyledikleriniz zaten ilk ifadenizde söylediklerinizle ayni.

 

[supernatural]

Ben yukarıdaki ilk ifanize göre istediğinizin aynisini yaptım.
Orada değişen ne oldu.
Zira son ifadenizde söyledikleriniz zaten ilk ifadenizde söylediklerinizle ayni.

Merhaba Evren Bey,
Kusura bakmayın biraz geç cevap verdim işlerimin yoğunluğundan dolayı.Haklısınız istediğimiz gibi olmuş sorunu bulduk sayı biçimlerinde olan farklılıktan kaynaklanıyormuş.Çok teşekkürler yardımlarınız için elinize emeğinize sağlık

 

[supernatural]

Çok soru sordum ama birşey daha sormam gerekiyor
raporun birindeki hücrelerdeki sayılar birinde 00001 olarak
diğerinde 01 olarak gözüküyor.

Üsteki sistemden 00001 olarak alınan sayı makro ile 01 haline getirilebilir mi?