[حل شده] قرار دادن اعداد در یک ستون

[amir0914]

سلام. دوستان برنامه ای میخوام که اعداد چند ستون رو به ستون اول زیر همون عدد بیاره.......مثل عکس پایین ، اعدادی که دارای ممیز هستند در ستون b , c در ستون a زیر همون عدد قرار بده ...البته من رنگ سبزهارو رو خودم دستی وارد کردم. ممنون

[rahi_feri]

سلام
کدش سادست ولی کار راه میفته!

Sub insertcopy()
Application.ScreenUpdating = False

Dim lrow As Long
Dim countnum As Long


lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

For i = lrow To 1 Step -1
countnum = Application.WorksheetFunction.Count(Rows(i))
If countnum > 1 Then
    Range(i + 1 & ":" & i + countnum - 1).Insert
    Range(Cells(i, 2), Cells(i, countnum)).Copy
    Cells(i, 1).Offset(1, 0).PasteSpecial Transpose:=True
End If
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
 
End Sub