Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Listede seçilenleri topluca başka sayfada yazdırma (http://www.excel.web.tr/showthread.php?t=161669)

excel12312 30-01-2017 12:26

Listede seçilenleri topluca başka sayfada yazdırma
 
1 Eklenti(ler)
Herkese iyi günler iyi çalışmalar.

Yapmak istediğim örnek çalışmada göreceğiniz üzere ürün kalemlerini tek tek ekle makrosu ile eklemek yerine tüm istenen kalmelerin adet ve metrajlarını belirledikten sonra "tek bir " ekle butonu ile diğer sayfaya yazdırmak.

Yardımlarınızı bekliyorum. Şimdiden teşekkürler.

Ömer BARAN 30-01-2017 14:55

Merhaba.

-- Belgenizdeki ilk EKLE düğmesi (CommandButton2) ve TEMİZLE (CommandButton1) düğmesi kalsın.
-- Varsa diğer diğer düğmeleri silin.
-- Belgedeki CommandButton1_Click kodu dışındaki kodları silin ve onların yerine aşağıdaki kodları yapıştırın.
-- Birinci EKLE düğmesini tablo dışına alıp, TEMİZLE düğmesi gibi konumlandırın.
.
Kod:

Sub EKLE()
Set a = Sheets("A"): Set b = Sheets("B")
For satır = 5 To a.[B65536].End(3).Row
    If a.Cells(satır, 2) <> "" And a.Cells(satır, 3) <> "" And a.Cells(satır, 4) _
        <> "" And a.Cells(satır, 5) <> "" And a.Cells(satır, 6) <> "" Then
        bsat = b.[C65536].End(3).Row + 1
            For sutun = 1 To 6
                b.Cells(bsat, sutun + 1) = a.Cells(satır, sutun)
            Next
    End If
Next
End Sub

Private Sub CommandButton2_Click()
Call EKLE
MsgBox "İşlem tamamlandı...", vbInformation, "...:: Ö. BARAN ::..."
End Sub


excel12312 30-01-2017 15:28

Elinize sağlık çok güzel olmuş fakat tek sorun bazı ürün kalemleri sadece adet olarak gözükmeli slikon vs.. gibi fakat program sadece adet ve metraj olanları yazdırıyor. Bunu nasıl çözebiliriz ?
Teşekkürler.

Ömer BARAN 30-01-2017 15:42

Tekrar merhaba.

F sütunu boş olanları da aktarmak için,
(buna göre B, C, D, E sütunu dolu olanlar aktarılacak)
önceki cevabımda kırmızı renklendirdiğim kısmı silmeniz yeterli olur.
Sayfayı yenileyerek önceki cevabımı kontrol edin.

Başka bir sayfada/alanda;
-- sadece MİKTAR yazılması yeterli olan ürün kodları listesi,
-- hem MİKTAR hem ÖLÇÜ yazılması gereken ürün kodları listesi
oluşturursanız, ÖLÇÜ yazılması gerektiği halde yazılmamışsa bunun aktarılması engellenebilir.
.

excel12312 30-01-2017 22:12

Selamlar,
harika, tam istediğim gibi oldu. Tekrardan çok teşekkürler iyi çalışmalar.

Ömer BARAN 31-01-2017 01:51

Alıntı:

excel12312 tarafından gönderildi (Mesaj 879977)
Selamlar,
harika, tam istediğim gibi oldu. Tekrardan çok teşekkürler iyi çalışmalar.

Kolay gelsin.
.

excel12312 01-02-2017 13:04

1 Eklenti(ler)
Tekrardan selamlar ve iyi çalışmalar. Bir sorum daha olacaktı aynı konu ile alakalı ilgilenme fırsatınız olur ise. Eklediğim dosya üzerinde "A" sayfasında EKLE butonuna basınca tüm seçilenleri sayfa "B" deki genel tabloya atıyor. Bunun yanında eklenecek kalemlerden sacede "Epoksi" leri tablo 2'ye "Koli" leri ise tablo 3'te yazdırmamız mümkün müdür aynı makroda ?
Teşekkürler iyi çalışmalar.

Ömer BARAN 01-02-2017 15:14

Tekrar merhaba.

EKLE adlı kod'u aşağıdakiyle değiştirince sanırım istediğiniz gerçekleşiyor.
.
Kod:

Sub EKLE()
Set a = Sheets("A"): Set b = Sheets("B"): Set s1 = Sheets("Sayfa1")
Set wf = Application.WorksheetFunction
For satır = 5 To a.[B65536].End(3).Row
    If a.Cells(satır, 2) <> "" And a.Cells(satır, 3) <> "" And a.Cells(satır, 4) _
        <> "" And a.Cells(satır, 5) <> "" Then
        b1sat = b.[C65536].End(3).Row + 1
        t2sat = b.[L65536].End(3).Row + 1
        s1sat = s1.[B65536].End(3).Row + 1
        For sutun = 2 To 6
            b.Cells(b1sat, sutun + 1) = Trim(a.Cells(satır, sutun))
            If Trim(a.Cells(satır, 3)) = "Epoksi" And wf.CountIf(b.Range("L7:O7"), a.Cells(4, sutun)) > 0 Then
                bsut = wf.Match(a.Cells(4, sutun), b.Range("L7:O7"), 0) + 11
                b.Cells(t2sat, bsut) = Trim(a.Cells(satır, sutun))
            End If
           
            If Trim(a.Cells(satır, 3)) = "Koli" And wf.CountIf(s1.Range("B5:E5"), a.Cells(4, sutun)) > 0 Then
                s1sut = wf.Match(a.Cells(4, sutun), s1.Range("B5:E5"), 0) + 1
                s1.Cells(s1sat, s1sut) = Trim(a.Cells(satır, sutun))
            End If
        Next
    End If
Next
MsgBox "İşlem tamamlandı...", vbInformation, "..:: O.BARAN ::.."
End Sub


excel12312 01-02-2017 17:00

Teşşekkürler cevap için, bir yer dikkatimi çekti sadece tablo 1 ve tablo 2 de Ürün isimlerinin gelmesi gereken yerlere tedarikçileri yazıyor. Nasıl düzeltebiliriz bunu ?

teşekkürler.

Ömer BARAN 02-02-2017 00:33

Tekrar merhaba.

8 numaralı cevapta verdiğim kod'u güncelledim. Sayfayı yenileyerek kontrol edin.

Önemli;tablo başlıkları kriter olarak kullanılıyor.
B sayfasındaki iki tablo ve Sayfa1'deki tablo başlıklarının,
A sayfasındaki başlıklarla birebir aynı olmasını sağladıktan sonra yeni kod'u çalıştırın.
.


Saat 22:39

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.