مشكل در گزارش گيري

[shamsololama]

باسلام و درود به اساتيد و دوستان گرامي
فايلي دارم كه از شيت 1 آن ميخوام گزارش بگيرم .فرمول اجرا ميشه منتها ميخوام گزارشم تو شيت 2 و توي دو صفحه بياد .يه اشكال كوچيكي داره كه نتونستم درستش كنم .اگه دوستان يه نگاهي بندازن و راهنماييم كنن ممنون ميشم .

http://persiandrive.com/429637

با درود فراوان

در صورتی که صفحه بندی شما همیشه یکسان بوده و تغییری نمیکند یعنی همیشه تا سطر سی ام نیاز داری برای صفحه اول و در صفحه دوم همیشه از سطر چهل و یکم به بعد باید پر بشه
با گذاشتن یک کانتر n=N+1 و یک شرط که اگر n از 30 بیشتر بشه بجای سلکت کردن سل A5 از آن به بعد سل A41 را سلکت کند فکر میکنم چیزی باشد که شما مد نظرتان باشد
و اگر غیر این بود بفرمائید تا دوباره چک کنم

Private Sub CommandButton1_Click()
Dim r As Integer
Sheet1.Activate
Sheet1.Range("N1").Value = TextBox1.Value
Sheet1.Select
r = Sheet1.Cells(Rows.Count, "a").End(xlUp).Row

For i = 1 To r

If Sheet1.Range("N1").Value = Sheet1.Cells(i, 6).Text Then
Sheet2.Select

If n < 30 Then
Range("a5").Select
Else
Range("a41").Select
End If

With Selection
Do

If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Offset(0, 0) = WorksheetFunction.Max(Range("a1:a1500")) + 1
ActiveCell.Offset(0, 1) = Sheet1.Cells(i, 2).Value
ActiveCell.Offset(0, 2) = Sheet1.Cells(i, 3).Value
ActiveCell.Offset(0, 3) = Sheet1.Cells(i, 5).Value
ActiveCell.Offset(0, 4) = Sheet1.Cells(i, 6).Value
ActiveCell.Offset(0, 5) = Sheet1.Cells(i, 7).Value
ActiveCell.Offset(0, 6) = Sheet1.Cells(i, 8).Value
n = n + 1
End With
End If
Next
Sheet2.Activate
End Sub


فایل نمونه:

[attachment=938]

[sohrabahmadi]

از لطف استاد عزيز بي اندازه ممنونم . بله درسته . فقط واسه اطلاعات عمومي اينكه اگه تعداد صفحات به سه يا بيشتر برسه چكار بايد كرد .به شرطي كه صفحات 3 به بعد هم مثل صفحه 2 تعداد رديفهاش 29 باشه ؟.با سپاس از استاد شمس العلماي عزيز.

[shamsololama]

از لطف استاد عزيز بي اندازه ممنونم . بله درسته . فقط واسه اطلاعات عمومي اينكه اگه تعداد صفحات به سه يا بيشتر برسه چكار بايد كرد .به شرطي كه صفحات 3 به بعد هم مثل صفحه 2 تعداد رديفهاش 29 باشه ؟.با سپاس از استاد شمس العلماي عزيز.

با درود فراوان

یک اینه که همون ایفی که قرار دادیم با اضاف کردن Elseif برای صفحه های بعدی نیز با شرط اینکه تعداد n به مقدار مورد نظر رسید جای سل مبدا رو تغییر بدیهم همانطور که برای صفحه دوم تغییر دادیم
ولی همانطور که میدانید اینکار زمانی که تعداد صفحه های ما زیاد باشد کار جالبی نخواهد شد که در این صورت می توانیم از متغییر و حلقه ها استفاده کنیم که کار ساده تر و زیباتر خواهد بود




Private Sub CommandButton2_Click()

Dim c As Range
Dim b As Range
For Each c In Sheet1.Range("A2:A1000")
n = 0
If c.Offset(0, 5).Text = TextBox1.Text Then
For Each b In Sheet2.Range("A5:A1000").Offset(0 + p, 0)
n = n + 1
If n = 30 Then
p = p + 36
n = 0
End If
If b.Offset(0, 0).Value = "" Then

M = M + 1

b.Offset(0, 0).Value = M
b.Offset(0, 1).Value = c.Offset(0, 1).Value
b.Offset(0, 2).Value = c.Offset(0, 2).Value
b.Offset(0, 3).Value = c.Offset(0, 4).Value
b.Offset(0, 4).Value = c.Offset(0, 5).Value
b.Offset(0, 5).Value = c.Offset(0, 6).Value
b.Offset(0, 6).Value = c.Offset(0, 7).Value

Exit For
End If
Next

End If
Next
End Sub

فایل نمونه:

[attachment=940]

[sohrabahmadi]

بسيار عالي .ممنون از استاد گرانقدر جناب آقاي شمس العلماي عزيز .