[حل شده] ایجاد ردیف و ستون و کپی اطلاعات

[ahmada1983]

سلام دوستان

فایلی که پیوست کردم قراره به تعداد عدد داخل سلول اول هر ردیف زیرش ردیف جدید ایجاد کنه و 6 تا هم ستون در مجموع اضافه می کنه حالا چیزی که نتونستم انجام بدم اینه که اطلاعات متناظر با شماره ستون دو رو از شیت 2 کپی کنه و توی ردیف ها و ستون های خالی بذاره.امیدوارم تونسته باشم منظورمو برسونم

[M_ExceL]

سلام دوستان

فایلی که پیوست کردم قراره به تعداد عدد داخل سلول اول هر ردیف زیرش ردیف جدید ایجاد کنه و 6 تا هم ستون در مجموع اضافه می کنه حالا چیزی که نتونستم انجام بدم اینه که اطلاعات متناظر با شماره ستون دو رو از شیت 2 کپی کنه و توی ردیف ها و ستون های خالی بذاره.امیدوارم تونسته باشم منظورمو برسونم

سلام،
داخل یک شیت جدید بصورت دستی وارد کنید و مشخص کنید که شیت نهایی دقیقا به چه شکل باید باشه؟

[ahmada1983]

توی فایل پیوست سه تا شیت گذاشتم شیت اول که قبل از ایجاد ردیف و ستونه و شیت دوم حالت نهایی و توی شیت سه هم اطلاعاتی که توی شیت دوم گذاشتم.

ممنون

[M_ExceL]

توی فایل پیوست سه تا شیت گذاشتم شیت اول که قبل از ایجاد ردیف و ستونه و شیت دوم حالت نهایی و توی شیت سه هم اطلاعاتی که توی شیت دوم گذاشتم.

ممنون

سلام،
داخل فایل، روی باتن ایجاد اطلاعات کلیک کنید

Sub M_E()
With Application
    .ScreenUpdating = False
    .EnableEvents = True
        lr1 = Sheets(2).Cells(Rows.Count, 1).End(3).Row
        lr2 = Sheets(1).Cells(Rows.Count, 1).End(3).Row
        t = 2
            For s1 = 1 To lr1
                For s2 = 1 To lr2
                    If Sheets(2).Cells(s1 + 2, 2) = Sheets(1).Cells(s2, 1) Then
                        Sheets(3).Cells(s2 + 1, 2) = Sheets(1).Cells(s2, 1)
                        Sheets(3).Cells(s2 + 1, 3) = Sheets(1).Cells(s2, 2)
                        Sheets(3).Cells(s2 + 1, 4) = Sheets(1).Cells(s2, 3)
                        Sheets(3).Cells(s2 + 1, 5) = Sheets(1).Cells(s2, 4)
                        Sheets(3).Cells(s2 + 1, 6) = Sheets(1).Cells(s2, 5)
                        Sheets(3).Cells(s2 + 1, 7) = Sheets(1).Cells(s2, 6)
                     End If
                Next s2
                        Sheets(3).Cells(t, 8) = Sheets(2).Cells(s1 + 2, 3)
                        Sheets(3).Cells(t, 9) = Sheets(2).Cells(s1 + 2, 4)
                        Sheets(3).Cells(t, 10) = Sheets(2).Cells(s1 + 2, 5)
                        Sheets(3).Cells(t, 11) = Sheets(2).Cells(s1 + 2, 6)
                        Sheets(3).Cells(t, 12) = Sheets(2).Cells(s1 + 2, 7)
                        Sheets(3).Cells(t, 13) = Sheets(2).Cells(s1 + 2, 8)
                        Sheets(3).Cells(t, 14) = Sheets(2).Cells(s1 + 2, 9)
                        t = t + Sheets(2).Cells(s1 + 2, 1)
            Next s1
        Sheets(3).Columns(3).WrapText = True
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

یا حق.

[ahmada1983]

خیلی عالی ممنون