Başka sayfalardan sıralı veri çekme

[excelience]

Merhaba ben oluşturduğum sayfalarda ki verilerin
ana sayfaya sıralı bir şekilde eklenmesini istiyorum.şimdiden teşekkürler...

 

[Ömer]

Merhaba,

I,J ve K sütunlarının karşılığını anlamadığım için boş bıraktım. Aynı mantıkla siz ekleyebilirsiniz.

Sub Listele()
    
    Dim syf(), sat As Long, i As Byte, son As Long
    
    syf = Array("AMBALAJ BÖLÜMÜ", "BEDEN BÖLÜMÜ", "YAKA BÖLÜMÜ", "PRES BÖLÜMÜ", "TEMİZLİK", "DİĞER")
    
    Application.ScreenUpdating = False
    Sheets("ANA SAYFA").Select
    Range("A3:N" & Rows.Count).Clear
    
    sat = 3
    For i = 0 To UBound(syf)
        With Sheets(syf(i))
            son = .Cells(Rows.Count, "B").End(xlUp).Row
            .Range("B4").Resize(son - 3, 3).Copy Cells(sat, "B")
            .Range("AP4").Resize(son - 3, 2).Copy
             Cells(sat, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AY4").Resize(son - 3, 1).Copy
             Cells(sat, "G").Resize(1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AJ4").Resize(son - 3, 1).Copy
             Cells(sat, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AO4").Resize(son - 3, 1).Copy
             Cells(sat, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            sat = sat + son - 3
        End With
    Next i
    
    Range("A3") = 1
    Range("A3").Resize(sat - 3, 1).DataSeries Rowcol:=xlColumns, _
        Type:=xlLinear, Date:=xlDay, Step:=1
    Range("E:E").NumberFormat = "0%"
    
    Range("A3:M" & sat - 1).Borders.LineStyle = 1
    
    Application.ScreenUpdating = True
    
End Sub

.

 

[excelience]

Ömer hocam çok teşşekürler süpersiniz Bunun yanı sıra ;
Buralarda sıkıntı yaşamaktayım hocam yardımlarınızı bekliyorum
*ANASAYFA DA Kİ H HÜCRESİ İLGİLİ BÖLÜMLERDE Kİ AN-AY FARKI
*RENKLENDİRME SÜPER FAKAT TÜM SATIRLAR İÇİN GEÇERLİ YAPABİLİRMİYİZ HOCAM (tüm satır derken m harfine kadar hocam )
*VE ANASAYFA DA Kİ I HÜCRESİ YİNE ANA SAYFADA Kİ F+H OLACAK
*YİNE ANASAYFA DA Kİ F,G,H,I hücreleri para birimi olarak gösterilecek hocam yardımlarınızı bekliyorum şimdiden Çok TEŞEKKKÜRLER...

 

[excelience]

Ömer hocam çok teşşekürler süpersiniz Bunun yanı sıra ;
Buralarda sıkıntı yaşamaktayım hocam yardımlarınızı bekliyorum
*ANASAYFA DA Kİ H HÜCRESİ İLGİLİ BÖLÜMLERDE Kİ AN-AY FARKI
*RENKLENDİRME SÜPER FAKAT TÜM SATIRLAR İÇİN GEÇERLİ YAPABİLİRMİYİZ HOCAM (tüm satır derken m harfine kadar yani hocam )
*VE ANASAYFA DA Kİ I HÜCRESİ YİNE ANA SAYFADA Kİ F+H OLACAK
*YİNE ANASAYFA DA Kİ F,G,H,I hücreleri para birimi olarak gösterilecek hocam yardımlarınızı bekliyorum şimdiden Çok TEŞEKKKÜRLER...

 

[Ömer]

H sütunu ile ilgili açıklamanızı anlamadım. Mevcut durum yanlış mı.

Sub Listele()
    
    Dim syf(), sat As Long, i As Byte, son As Long
    
    syf = Array("AMBALAJ BÖLÜMÜ", "BEDEN BÖLÜMÜ", "YAKA BÖLÜMÜ", "PRES BÖLÜMÜ", "TEMİZLİK", "DİĞER")
    
    Application.ScreenUpdating = False
    Sheets("ANA SAYFA").Select
    Range("A3:N" & Rows.Count).Clear
    
    sat = 3
    For i = 0 To UBound(syf)
        With Sheets(syf(i))
            son = .Cells(Rows.Count, "B").End(xlUp).Row
            .Range("B4").Resize(son - 3, 3).Copy Cells(sat, "B")
            .Range("AP4").Resize(son - 3, 2).Copy
             Cells(sat, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AY4").Resize(son - 3, 1).Copy
             Cells(sat, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AN4").Resize(son - 3, 1).Copy
             Cells(sat, "H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AJ4").Resize(son - 3, 1).Copy
             Cells(sat, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            .Range("AO4").Resize(son - 3, 1).Copy
             Cells(sat, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            sat = sat + son - 3
        End With
    Next i
    
    Range("A3") = 1
    Range("A3").Resize(sat - 3, 1).DataSeries Rowcol:=xlColumns, _
        Type:=xlLinear, Date:=xlDay, Step:=1
    Range("E:E").NumberFormat = "0%"
    Range("F:K").NumberFormat = "#,##0.00 $"
    
    Range("A3:M" & sat - 1).Borders.LineStyle = 1
    Range("A3:M" & sat - 1).Interior.ColorIndex = 0
    
    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        Cells(i, "H") = Cells(i, "H") - Cells(i, "G")
        Cells(i, "I") = Cells(i, "F") + Cells(i, "H")
        If i Mod 2 = 0 Then
            Cells(i, "A").Resize(1, 13).Interior.ThemeColor = xlThemeColorDark2
        End If
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

.

 

[excelience]

hocam h sutunu ambalajda ki an-ay olacak ör: bedir çelik ambalaj bölümünde 500 hak etmis ama avans olarak toplamda 150 tl çekmiş ana sayfada ki h sütununa 500-150
=350 gelmesi gerekiyor
yine diğer bölümlerde de hak edişten toplam çekilen avans çıkarıldıktan sonra ana sayfa da ki h sütununa bu farkın gelmesi gerekli

 

[excelience]

h sütunu dışında diğerleri takır takır çalışıyor maşallah hocam

 

[Ömer]

#5 numaralı mesajı güncelledim.

.

 

[excelience]

5 numara 10 yıldızdan daha fazlası .ÇOK TEŞEKKÜR ederim Ömer hocam.