[حل شده] اضاف شدن شیت های خودکار

[habib100]

با سلام و خسته نباشید خدمت همه
فایلی که گذاشته ام دو شیت دارد شیت 1 دارای مقادیری هست که از جایی دیگر کپی می شود و در اینجا قرار میگیرد و وشیت report1 که داده هایش را اکثرا از شیت 1 می خواند و تعداد 15 آیتم در آن ریپورت قرا میگیرد . حال می خواهم اگر داده ها در شیت 1 بیش از 15 آیتم بود یک کپی از شیت 1 گرفته شود به نام report2 و بقیه آیتمها (ردیفهای شیت 1 بیشتر از 15 ) درون آن بنشیند و سلول قرمز شده شیت report1 عدد 2 شود و در شیت report2 شماره page 1 of 2 به 2 of 2 تبدیل شود. وبا کلیک بر روی دکمه آبی این عملیات صورت بگیرد.
خیلی ممنونم

[habib100]

با سلام
دوستان راهنمایی میفرمایید؟.
تشکر

[M_ExceL]

با سلام و خسته نباشید خدمت همه
فایلی که گذاشته ام دو شیت دارد شیت 1 دارای مقادیری هست که از جایی دیگر کپی می شود و در اینجا قرار میگیرد و وشیت report1 که داده هایش را اکثرا از شیت 1 می خواند و تعداد 15 آیتم در آن ریپورت قرا میگیرد . حال می خواهم اگر داده ها در شیت 1 بیش از 15 آیتم بود یک کپی از شیت 1 گرفته شود به نام report2 و بقیه آیتمها (ردیفهای شیت 1 بیشتر از 15 ) درون آن بنشیند و سلول قرمز شده شیت report1 عدد 2 شود و در شیت report2 شماره page 1 of 2 به 2 of 2 تبدیل شود. وبا کلیک بر روی دکمه آبی این عملیات صورت بگیرد.
خیلی ممنونم

سلام،
فایل پیوست رو چک کنید.

Sub M_excel()
Dim h, i, u As Long
Dim sc, sc2 As Long
Dim endrow As Long
endrow = Sheets(1).Cells(Rows.Count, 1).End(3).Row
h = 15
Do While h < endrow
    sc = Sheets.Count
    h = h + 15
    Sheets(2).Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).DisplayRightToLeft = False
    sc2 = Sheets.Count
    If sc2 > cs1 Then
        u = h - 15
        For i = 5 To 19
            Sheets(Sheets.Count).Name = "REPORT" + Str(sc2 - 1)
            Sheets(Sheets.Count).Range("c" & i) = "=IF(Sheet1!B" & u & "="""","""",Sheet1!B" & u & ")"
            Sheets(Sheets.Count).Range("h" & i) = "=IF(Sheet1!c" & u & "="""","""",Sheet1!c" & u & ")"
            Sheets(Sheets.Count).Range("i" & i) = "=IF(Sheet1!d" & u & "="""","""",Sheet1!d" & u & ")"
            u = u + 1
        Next
    End If
Loop

For i = 2 To Sheets.Count
    Sheets(i).Range("z2") = i - 1
    Sheets(i).Range("ab2") = Sheets.Count - 1
Next
End Sub

[habib100]

سلام
خیلی زحمت کشیدید. فقط آیتم ردیف 15و 16 در شیت 1( یا 14 و 15 در شیت report 1 ) را تکراری میزند یعنی در شیت report 2 هم میزندو در کل دو ردیف رو اضافه میزند و اگر میشود میخواهم شماره row
در شیت report ها در ستون item پشت سر هم بیفتد .
ممنون

[M_ExceL]

سلام
خیلی زحمت کشیدید. فقط آیتم ردیف 15و 16 در شیت 1( یا 14 و 15 در شیت report 1 ) را تکراری میزند یعنی در شیت report 2 هم میزندو در کل دو ردیف رو اضافه میزند و اگر میشود میخواهم شماره row
در شیت report ها در ستون item پشت سر هم بیفتد .
ممنون

سلام،
خواهش میکنم
مواردی که اشاره فرمودید اصلاح گردید

Sub M_excel()
Dim h, i, u As Long
Dim sc, sc2 As Long
Dim endrow As Long
endrow = Sheets(1).Cells(Rows.Count, 1).End(3).Row
h = 15
Do While h < endrow
    sc = Sheets.Count
    h = h + 15
    Sheets(2).Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).DisplayRightToLeft = False
    sc2 = Sheets.Count
    If sc2 > cs1 Then
        u = h - 13
        Sheets(Sheets.Count).Name = "REPORT" + Str(sc2 - 1)
        For i = 5 To 19
            Sheets(Sheets.Count).Range("a" & i) = u - 1
            Sheets(Sheets.Count).Range("c" & i) = "=IF(Sheet1!B" & u & "="""","""",Sheet1!B" & u & ")"
            Sheets(Sheets.Count).Range("h" & i) = "=IF(Sheet1!c" & u & "="""","""",Sheet1!c" & u & ")"
            Sheets(Sheets.Count).Range("i" & i) = "=IF(Sheet1!d" & u & "="""","""",Sheet1!d" & u & ")"
            u = u + 1
        Next
    End If
Loop

For i = 2 To Sheets.Count
    Sheets(i).Range("z2") = i - 1
    Sheets(i).Range("ab2") = Sheets.Count - 1
Next
End Sub

[habib100]

خیلی ممنون.
دانشتان روز افزون