satır ekleme macrosu yardım

[Sendouh]

merhabalar excelde malzeme adı ve karşısında adeti olan bir tablom var

örn: A1 de Masa yazıyor B1 de 5 yazıyor

simdi öyle birşey yapmalıyımki MASA - 5 yazan yeri

Masa 1
Masa 1
Masa 1
Masa 1
Masa 1 şeklinde B1 deki sayı kadar sıralasın bu konuda fikri olan varsa paylaşabilirmi?

el ile yapılacak kadar az değil 8bin satır felan var şimdiden teşekkürler.

 

[asi_kral]

Dosya ekleyebilir misiniz_?
İçinde açıklama eklerseniz çözüm üretmemiz daha kolay olacaktır.

 

[Sendouh]

dosya ekliyorum 43. satır ve 55. satıra 2 açıklama ekledim umarım anlatabilmişimdir. teşekkürler

 

[asi_kral]

dosya ekliyorum 43. satır ve 55. satıra 2 açıklama ekledim umarım anlatabilmişimdir. teşekkürler

Benim anladığım şu : C sütununda yazan adet kadar alta çoğaltması ve adet'i tek'e indirmesi üstteki verileri alttaki eklenen satırlara aktarması. Umarım yanlış anlamadım.

 

[Sendouh]

aynen öyle kardeşim

 

[asi_kral]

aynen öyle kardeşim

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub ekle_1967()
'Konu       :   Adet Kadar Ürün Çoğalt
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As Long
Application.ScreenUpdating = False
For asi = 3 To WorksheetFunction.Sum(Range("C:C"))
If Cells(asi, "C") > 1 Then
Rows(asi + 1 & ":" & asi + 1 + Cells(asi, "C") - 2).Insert shift:=xlDown
Cells(asi, "C") = 1
End If
If Cells(asi, "C") = Empty Then
Cells(asi, "B") = Cells(asi - 1, "B"): Cells(asi, "C") = Cells(asi - 1, "C")
Cells(asi, "D") = Cells(asi - 1, "D"): Cells(asi, "E") = Cells(asi - 1, "E")
Cells(asi, "F") = Cells(asi - 1, "F")
End If: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[Sendouh]

çok çok teşekkür ederim. Allah razı olsun. iyi çalışmalar

 

[asi_kral]

çok çok teşekkür ederim. Allah razı olsun. iyi çalışmalar

Kolay Gelsin.