قرار دادن اعداد در یک ستون

[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