satır kopyalayarak belli sayıda yazdırma

[ormanci_50]

merhaba
arkadaşlar sayfada bulunan bir hücreyi kopyalayıp b8 itibaren, yine bir hücrede yazan değer kadar yazdırmak istiyorum.

teşekkürler

 

[asi_kral]

Merhaba
Açıklamalar yetersiz.

 

[ormanci_50]

merhaba
mavi tablodaki yazıları adet sayısı kadar boş tabloya yapıştırmak istiyorum

 

[ormanci_50]

slm hocam
tablo bu şekilde olsa da olur makro yazamadım
1 tobloda ki adet kısmı kadar satırları çoğaltıp tekrar tablo yapmak istiyorum.
teşekkürler

 

[asi_kral]

Aynı sayfada mı olacak yoksa ayrı sayfada mı_?

 

[ormanci_50]

aynı sayfada

 

[asi_kral]

aynı sayfada

Peki ana veriler kaç satır olacak bu belli mi_?
Hangi satırdan itibaren tek adet olarak listelenmeye başlayacak.

 

[ormanci_50]

en fazla 15 satır olur
hangi satırdan başladığı önemli değildir.
teşekkürler

 

[asi_kral]

en fazla 15 satır olur
hangi satırdan başladığı önemli değildir.
teşekkürler

Merhaba
Kodu bir sefer çalıştırınız.
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub tek_Adetli_liste()
'Konu       :   Adetleri teke göre listele
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As Long, a As Long
Application.ScreenUpdating = False
kral = Range("A" & Rows.Count).End(xlUp).Row + 4
For asi = 2 To kral - 4
For a = 1 To Cells(asi, "D")
Cells(kral, "A") = Cells(asi, "A")
Cells(kral, "B") = Cells(asi, "B")
Cells(kral, "C") = Cells(asi, "C")
Cells(kral, "D") = 1
Cells(kral, "E") = Cells(asi, "E")
Cells(kral, "F") = Cells(asi, "F")
kral = kral + 1
Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[ormanci_50]

hocam eline sağlık
bir sorum var
miktar ve kg adete bölerek 2. tabloyu oluşruturabilirmiyi?
teşekkürler

 

[asi_kral]

hocam eline sağlık
bir sorum var
miktar ve kg adete bölerek 2. tabloyu oluşruturabilirmiyi?
teşekkürler

Sorunuzu anlamadım. Lütfen daha detaylı ve dosya içinde açıklayınız.

 

[baydeniro]

Sayın asi kral 1967, ben de çok çok teşekkür ederim, bu kod çok işime yarayacak.

 

[asi_kral]

Sayın asi kral 1967, ben de çok çok teşekkür ederim, bu kod çok işime yarayacak.

Kolay Gelsin.

 

[ormanci_50]

Hocam tekrar ekli dosyaya baka bilmisiniz?
Ilginiz için çok teşekküler

 

[asi_kral]

Hocam tekrar ekli dosyaya baka bilmisiniz?
Ilginiz için çok teşekküler

Merhaba
Kodu bununla değiştirip dener misiniz_?

Option Explicit
Sub tek_Adetli_liste()
'Konu       :   Adetleri teke göre listele
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As Long, a As Long
Application.ScreenUpdating = False
Range("A30:F" & Rows.Count).ClearContents
kral = 30
For asi = 2 To Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To Cells(asi, "D")
Cells(kral, "A") = Cells(asi, "A")
Cells(kral, "B") = Cells(asi, "B") / Cells(asi, "D")
Cells(kral, "C") = Cells(asi, "C")
Cells(kral, "D") = 1
Cells(kral, "E") = Cells(asi, "E")
Cells(kral, "F") = Cells(asi, "F") / Cells(asi, "D")
kral = kral + 1
Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[ormanci_50]

Hocam çok teşekkürler
elinize sağlık

 

[asi_kral]

Hocam çok teşekkürler
elinize sağlık

Kolay Gelsin.