پرسش انتقال شرطی توابع به شیت جدید

[salmanzbd]

با سلام و وقت بخیر
یه سوال تخصصی دارم در صورت امکان راهنماییم کنین ممنون میشم
یه فایل اکسل دارم که 8 تا شیت داره
میخوام در صورتیکه در انتهای ردیف ها عدد 0 وجود داشت اطلاعات چندتا ستون اون ردیف به همراه نام اون شیت در یه شیت جدید نمایش داده بشه
همینطور شیت های دیگه هم اگر این شرط حاکم بود اطلاعات اون ردیف ها زیر هم بشینه توی اون شیت جدیدم.
اگر بتونین راهنماییم کنین خیلی ممنونتون میشم

[iranweld]

سلام

نمونه فایل ضمیمه سایت کنید

[salmanzbd]

سلام

نمونه فایل ضمیمه سایت کنید

با یه موضوع جدید سوال رو مطرح کردم

- - - Updated - - -

فایل

[iranweld]

با سلام

گزارشگیری در شیت جدید data را بررسی بفرمایید

برای اجرای ماکرو ، کلیه سلولهای مرچ شده به حالت غیر مرچ برگشت داده شدند

Sub test()

Application.ScreenUpdating = False

Sheets("data").Cells.ClearContents

For Each Sheet In Worksheets

If Sheet.Name <> "data" Then

Sheet.Select

endrow = Sheet.Cells(Sheet.Rows.Count, "b").End(xlUp).Row

For i = 7 To endrow

k1 = Application.WorksheetFunction.CountA(Sheet.Range(i & ":" & i))

If k1 > 0 Then

If Sheet.Range("g" & i) <= 0 And Sheet.Range("g" & i) <> "" Then

k = Sheet.Name

z2 = Sheets("data").Cells(Sheets("data").Rows.Count, "b").End(xlUp).Row + 1

Range("b" & i & ":j" & i).Copy

Sheets("data").Range("b" & z2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



Sheets("data").Range("a" & z2) = k

End If

End If

Next

End If

Next



Sheets("data").Select

Application.ScreenUpdating = True

End Sub