Sticker Basma Sorunu.. HELP ME !!

Katılım
28 Temmuz 2008
Mesajlar
18
Excel Vers. ve Dili
xp
Altın Üyelik Bitiş Tarihi
29-07-2021
Arkadaşlar merhaba,

Öncelikle zaman ayırdığınız için teşekkür ederim.

İşe ve Excele yeni başladım dilim döndükçe sorunumu anlatmaya çalışcam.

Günde nerdeyse 100 adet sticker çıktı alıyorum, çok fazla zaman almasının yanında çok fazla müsvette sticker kalıyor.
yapmak istediğime gelirsek,

Bir sekmede bulunan verileri belirtilen adet kadar başka bir sekmede stickerlara aktarmak. Belki sizle için küçük bir işlem ama yardımcı olursanız çok sevinirim..


Detaylı anlatımı Örnek olarak EK deki dosyada var.

Şimdiden yardımlarınız için teşekkür ederim.
 

Ekli dosyalar

Katılım
14 Nisan 2013
Mesajlar
764
Excel Vers. ve Dili
Office Excel 2016 TR
Home & Business
Altın Üyelik Bitiş Tarihi
30.12.2018
Merhaba,

ben etiket çıkartmak için genelde Word'de bulunan etiketler özelliğini kullanıyorum. Bunu denediniz mi
 
Katılım
28 Temmuz 2008
Mesajlar
18
Excel Vers. ve Dili
xp
Altın Üyelik Bitiş Tarihi
29-07-2021
Evet word üzerinde denedim ama istediğim şekilde olmadı hatta işleri uzattı desem yeridir.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,361
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?
Umarım doğru anlamışımdır.

Kod:
Sub Doldur()

    Dim s1  As Worksheet, _
        sV  As Worksheet, _
        Adr As String, _
        c   As Range, _
        i   As Integer, _
        j   As Integer, _
        k   As Integer, _
        Adt As Integer
    
    Set s1 = Sheets("21")
    Set sV = Sheets("Veri")
    
    Application.ScreenUpdating = False
    
    s1.Range("D:D,H:H,L:L").ClearContents
    
    i = 2
    k = 4
    
    For j = 2 To sV.Range("A9").End(xlToRight).Column
        If Not sV.Cells(9, j) = 0 And IsNumeric(sV.Cells(9, j)) = True Then
            For Adt = 1 To sV.Cells(9, j)
                sV.Range("B4:B6").Copy s1.Cells(i, k)
                s1.Cells(i + 3, k) = sV.Cells(7, j)
                k = k + 4
                If k > 12 Then
                    k = 4
                    i = i + 6
                End If
            Next Adt
        End If
    Next j
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "www.excel.web.tr"
    
End Sub
 
Katılım
28 Temmuz 2008
Mesajlar
18
Excel Vers. ve Dili
xp
Altın Üyelik Bitiş Tarihi
29-07-2021
Necdet Bey,

Ellerinize sağlık, düşündüğümden de iyi olmuş.

Kaç gündür uğraşıyordum, beni büyük bir yükten kurtardınız. ellerinize sağlık. İyi çalışmalar...
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,361
Excel Vers. ve Dili
Ofis 365 Türkçe
Necdet Bey,

Ellerinize sağlık, düşündüğümden de iyi olmuş.

Kaç gündür uğraşıyordum, beni büyük bir yükten kurtardınız. ellerinize sağlık. İyi çalışmalar...
Güle güle kullanınız.
 
Üst