Satışlar Sayfasındaki Koşullara Göre tsb Sayfasına veri aktarımı

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
hsr_tsb_taslak dosyası daha küçük ve daha anlaşılır.....ilgilenirseniz sevinirm.
1. sayfa oluşuyor amaç ikinci sayfayıda oluşturmak.


Son = Sütundaki son dolu satır
i = 12 yazan satır
gunsat Sayfası "A2:A" & son aralığında 12 yazıyorsa
Sırayla;

Gunsat e&i yi > tsb!a11:a44, tsb!g11:g44, tsb!a53:a87, tsb!g53:g87, aralığına
Gunsat C&i yi > tsb!b11:b44, tsb!h11:h44, tsb!b53:b87, tsb!h53:h87, aralığına
Gunsat g&i yi > tsb!e11:e44, tsb!k11:k44, tsb!e53:e87, tsb!k53:k87, aralığına
yazmasını isityorum


Gunsat e&i yi > tsb!a11:a44, tsb!g11:g44, aralığına
Gunsat C&i yi > tsb!b11:b44, tsb!h11:h44, aralığına
Gunsat g&i yi > tsb!e11:e44, tsb!k11:k44, aralığına
yazması için kullandığım kodlar (Sn. LeventM e tekrar teşekkür ederim)

Kod:
Sub ev()
SifreAc
'evstokçıkışyaz>>>>>>>>>>>>>>>>>>>>>>>>>
For g = 3 To Bu_s1.[a65536].End(3).Row
    '12+P>>>>>>>>>>>>>>
    If Bu_s1.Cells(g, 1) = "12" And (Bu_s1.Cells(g, 2) = "P" Or Bu_s1.Cells(g, 2) = "p") Then
    c = c + 1
        'ikinci sütun kontrolü
        If c = 35 Then
            sut = 6: c = 1
        End If
        'Kayıt sayısı kontrolü
        If WorksheetFunction.CountA(Bu_s2.[e11:e44,k11:k44]) = 68 Then
        MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI": Exit Sub
        End If
    '12 lik stok çıkış yazma işlemi
    Bu_s2.Cells(c + 10, 1 + sut) = Bu_s1.Cells(g, 5)
    Bu_s2.Cells(c + 10, 2 + sut) = UCase(Bu_s1.Cells(g, 4))
    Bu_s2.Cells(c + 10, 5 + sut) = Bu_s1.Cells(g, 7)
    '<<<<<<<<<<<<<<12+P
    '--------------------------------------------
    '12+V>>>>>>>>>>
    ElseIf Bu_s1.Cells(g, 1) = "12" And (Bu_s1.Cells(g, 2) = "V" Or Bu_s1.Cells(g, 2) = "v") Then
    c = c + 1
        'ikinci sütun kontrolü
            If c = 35 Then
                sut = 6: c = 1
            End If
        'ev stok Kayıt sayısı kontrolü
            If WorksheetFunction.CountA(Bu_s2.[e11:e44,k11:k44]) = 68 Then
                MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI": Exit Sub
            End If
        '12 lik stok çıkış yazma işlemi
            Bu_s2.Cells(c + 10, 1 + sut) = Bu_s1.Cells(g, 5)
            Bu_s2.Cells(c + 10, 2 + sut) = UCase(Bu_s1.Cells(g, 4))
            Bu_s2.Cells(c + 10, 5 + sut) = Bu_s1.Cells(g, 7)
        '>>>>>>>>>>>>>>>>>>>>>>>biçimlendir
            With Bu_s2.Range(Bu_s2.Cells(c + 10, 1 + sut), Bu_s2.Cells(c + 10, 5 + sut + 1))
            With .Font: .Bold = True: .ColorIndex = 2: End With: .Interior.ColorIndex = 1
            End With
        '<<<<<<<<<<<<<<<<<<<<<<<biçimlendir
    '<<<<<<<<<<<<<<<<<12+V
    End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<evstokçıkışyaz
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Veresiyeleri ve peşinleri ayrı ayrı topla
Bu_s2.Cells(47, 5) = brdrenktopla(Bu_s2.[e11:f44], 1, 2, 1)        'veresiye tutar
Bu_s2.Cells(47, 1) = brdrenktopla(Bu_s2.[a11:a44], 1, 2, 1)         'veresiye adet
Bu_s2.Cells(48, 5) = brdrenktopla(Bu_s2.[e11:f44], -4142, -4105, 1)   'peşin tutar
Bu_s2.Cells(48, 1) = brdrenktopla(Bu_s2.[a11:a44], -4142, -4105, 1)    'peşin adet
'[[[[[[[[[[[[[[[[[[[[[[[[[[ev tüp ikinci kolon]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
Bu_s2.Cells(47, 11) = brdrenktopla(Bu_s2.[K11:L44], 1, 2, 1)       'veresiye tutar
Bu_s2.Cells(47, 7) = brdrenktopla(Bu_s2.[G11:G44], 1, 2, 1)         'veresiye adet
Bu_s2.Cells(48, 11) = brdrenktopla(Bu_s2.[K11:L44], -4142, -4105, 1)  'peşin tutar
Bu_s2.Cells(48, 7) = brdrenktopla(Bu_s2.[G11:G44], -4142, -4105, 1)    'peşin adet
'Veresiyeleri ve peşinleri ayrı ayrı topla<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
SifreKapa
End Sub
 
Son düzenleme:
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
g&#252;ncel.. yard&#305;mlar&#305;n&#305;z i&#231;in &#351;imdiden te&#351;ekk&#252;rler
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
&#304;lk mesaja &#246;rnek ekledim....
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
g&#287;ncel k&#252;&#231;&#252;lt&#252;lm&#252;&#351; dosya eklenmi&#351;tir.
 
Üst