[حل شده] مشکل در حلقه تکرار

[perspolis52]

سلام دوستان

Private Sub save_Click()
On Error Resume Next

Range("a1").Select
endrow = info.Range("a:a").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Dim c As Range
For Each c In Range("a1:a" & endrow)
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Next
Selection = name_code.Text
ActiveCell.Offset(0, 3).Value = num.Text
ActiveCell.Offset(0, 2).Value = month.Text
End Sub

این کد رو اگه بخوام به تعداد اعداد موجود در num.Text تکرار کنم باید چه کار کنم. مثلا اگه توی num.Text عدد 5 هست این عملیات 5 بار تکرار بشه.
ممنون میشم اگه جواب بدین

[iranweld]

نمونه فایل را بصورت زیپ شده ضمیمه سایت کنید

[perspolis52]

نمونه فایل را بصورت زیپ شده ضمیمه سایت کنید

بیا دادا اینم فایل

[Ali Parsaei]

سلام،
بيا دادا اينم کد:

Private Sub save_Click()
Dim D As Integer
D = num.Value
Do While D > 0
On Error Resume Next
morakhasi.Activate
Range("a1").Selectendrow = sheet1.Range("a:a").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Dim c As Range
For Each c In Range("a1:a" & endrow)
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).SelectEnd IfNextSelection = name_code.Text
ActiveCell.Offset(0, 3).Value = num.Text
ActiveCell.Offset(0, 2).Value = month.Text
D = D - 1
Loop
name_code.Text = ""
num.Text = ""
month.Text = ""
End Sub 

[perspolis52]

سلام،
بيا دادا اينم کد:

Private Sub save_Click()
Dim D As Integer
D = num.Value
Do While D > 0
On Error Resume Next
morakhasi.Activate
Range("a1").Selectendrow = sheet1.Range("a:a").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Dim c As Range
For Each c In Range("a1:a" & endrow)
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).SelectEnd IfNextSelection = name_code.Text
ActiveCell.Offset(0, 3).Value = num.Text
ActiveCell.Offset(0, 2).Value = month.Text
D = D - 1
Loop
name_code.Text = ""
num.Text = ""
month.Text = ""
End Sub 

خیلی ممنون و لی خطای "Loop Without Do" میده؟؟

[Ali Parsaei]

ببخشيد، موقع درج کد در سايت يک کم به هم ريختگي ايجاد شد، اين فايل را ببينيد:

Private Sub save_Click()
Dim D As Integer
D = num.Value
On Error Resume Next
morakhasi.Activate
Range("a1").Select
endrow = sheet1.Range("a:a").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Dim c As Range
For Each c In Range("a1:a" & endrow)
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Next
Do While D > 0
Selection = name_code.Text
ActiveCell.Offset(0, 3).Value = num.Text
ActiveCell.Offset(0, 2).Value = month.Text
Selection.Offset(1, 0).Select
D = D - 1
Loop
name_code.Text = ""
num.Text = ""
month.Text = ""
End Sub