[حل شده] انتقال اطلاعات از دوشیت به یک شیت بصورت خاص !

[Skynet]

با سلام و احترام خدمت اساتید و دوستان عزیز
درخواست راهنمایی و ماکرویی جهت انتقال اطلاعات از دوشیت به یک شیت بصورت خاصی را دارم ، خیلی ممنون میشم اگر امکان داشته باشه ، توجه و بررسی نمایید.
در این فایل سه شیت در اختیار داریم : Home , a , b
اطلاعات رکورد های شیت a و b تقریبا یکی هست و وجه اشتراکشون شماره چک می باشد. لازم به ذکر هست که بعضی چک ها فقط در a هست و بعضی فقط در b و بعضی دیگر در هر دو شیت a و b .
من قبلا در شیت a شماره چک هایی که در b بود رو پیدا می کردم و در نهایت در b فیلنتر می کردم چک هایی که در هر دو شیت وجود داشتند و کپی کرده و اونها رو می آوردم در home .

اما الان علاوه بر انتقال اطلاعات بصورت فوق به دو تغییر دیگه نیاز دارم:
1- رکورد هایی که فقط در a و یا فقط در b هستند نیز به انتهای جدول home هم منتقل شوند
2- در ستون توضیحات در home درج بشه که رکورد مربوطه در کدام جدول بوده ! ( فقط در a یا فقط در b و یا موجود در هر دو جدول )
با تشکر فراوان از اساتید عزیز

[Skynet]

با سلام و احترام خدمت اساتید و دوستان عزیز
درخواست راهنمایی و ماکرویی جهت انتقال اطلاعات از دوشیت به یک شیت بصورت خاصی را دارم ، خیلی ممنون میشم اگر امکان داشته باشه ، توجه و بررسی نمایید.
در این فایل سه شیت در اختیار داریم : Home , a , b
اطلاعات رکورد های شیت a و b تقریبا یکی هست و وجه اشتراکشون شماره چک می باشد. لازم به ذکر هست که بعضی چک ها فقط در a هست و بعضی فقط در b و بعضی دیگر در هر دو شیت a و b .
من قبلا در شیت a شماره چک هایی که در b بود رو پیدا می کردم و در نهایت در b فیلنتر می کردم چک هایی که در هر دو شیت وجود داشتند و کپی کرده و اونها رو می آوردم در home .

اما الان علاوه بر انتقال اطلاعات بصورت فوق به دو تغییر دیگه نیاز دارم:
1- رکورد هایی که فقط در a و یا فقط در b هستند نیز به انتهای جدول home هم منتقل شوند
2- در ستون توضیحات در home درج بشه که رکورد مربوطه در کدام جدول بوده ! ( فقط در a یا فقط در b و یا موجود در هر دو جدول )
با تشکر فراوان از اساتید عزیز

[ATTACH=CONFIG]14556[/ATTACH][ATTACH=CONFIG]14557[/ATTACH][ATTACH=CONFIG]14558[/ATTACH]

با سلام و احترام خدمت عزیزان
ان شالله که از ایام عید ، به بهترین نحو ممکن استفاده کنید ، ما که بدلیل نیاز به اتمام پروژه ، روز و شبمون پای سیستم و دوست قدیمون اکسل در حال گذران هست
من بلاخره موفق شدم بین دو تا ستون از دو تا شیت مختلف مقاسیه ای رو برای کشف عناصر غیر تکراری ، بدست بیارم ، تقریبا به کمک فایل های موجود در این انجمن و بررسی همگی اونها توستم به نتایج خوبی برای حل این سوال برسم و نهایتا" این کد رو تونستم تهیه کنم :

Sub Macro5()

z1 = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row

z11 = Sheet3.Cells(Sheet3.Rows.Count, "B").End(xlUp).Row

Z2 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1


'NAME SHEET :A
Sheet2.Range("B2" & ":B" & z1).Copy Destination:=Sheet1.Range("B" & Z2)
Sheet2.Range("C2" & ":C" & z1).Copy Destination:=Sheet1.Range("c" & Z2)
Sheet2.Range("D2" & ":D" & z1).Copy Destination:=Sheet1.Range("D" & Z2)
Sheet2.Range("E2" & ":E" & z1).Copy Destination:=Sheet1.Range("E" & Z2)
Sheet2.Range("F2" & ":F" & z1).Copy Destination:=Sheet1.Range("F" & Z2)
Sheet2.Range("G2" & ":G" & z1).Copy Destination:=Sheet1.Range("G" & Z2)
Sheet2.Range("H2" & ":H" & z1).Copy Destination:=Sheet1.Range("H" & Z2)
Sheet2.Range("I2" & ":I" & z1).Copy Destination:=Sheet1.Range("I" & Z2)
Sheet2.Range("J2" & ":J" & z1).Copy Destination:=Sheet1.Range("J" & Z2)

'NAME SHEET :B
Sheet3.Range("B2" & ":B" & z11).Copy Destination:=Sheet1.Range("C" & Z2)
Sheet3.Range("D2" & ":D" & z11).Copy Destination:=Sheet1.Range("G" & Z2)
Sheet3.Range("E2" & ":E" & z11).Copy Destination:=Sheet1.Range("H" & Z2)
Sheet3.Range("F2" & ":F" & z11).Copy Destination:=Sheet1.Range("I" & Z2)
Sheet3.Range("G2" & ":G" & z11).Copy Destination:=Sheet1.Range("J" & Z2)

End Sub

اما در حال حاظر به دوتا مشکل برخوردم :
1- چطور در این قسمت از کد تعریف کنم که فقط عناصری رو در سطر B برای کپی انتخاب کن که من فیلترشون کردم !

Sheet2.Range("B2" & ":B" & z1).Copy Destination:=Sheet1.Range("B" & Z2)

2- چطور در این قسمت از کد، تعریف کنم که بعد از اتمام کپی مرحله اول از شیت A ، بیا به داخل شیت HOME و اخرین سطر رو پیدا کن و حالا عملیات کپی از شیت B رو در اینجا زیر اخرین سطر پیست کن !

در حال حاظر متاسفانه مرحله دوم کپی بر روی مرحله اول کپی ، پیست میشه !

خیلی ممنونم میشم راهنمایی کنید . مرسی

[Skynet]

دوستان به کمک شما نیاز دارم Please Help Meeee

[iranweld]

با سلام

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

Sub test()

z1 = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To z1

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next

End Sub 

[Skynet]

با سلام

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

Sub test()

z1 = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To z1

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next

End Sub 

باسلام و احترام

iranweld

عزیز
خیلی خیلی ممنونم از کد عالیتون در بسیاری از فایل های در دست می تونم استفاده کنم متشکرممم.
فقط یک نکته مونده که ظاهرا جامونده
یکی از مشکلاتم اینه که چطور بعد از کپی اطلاعات از شیت A به شیت home، حالا بیام اطلاعات فیلتر شده در شیت B رو هم کپی کرده و بیام شیت home زیر اخرین سطر موجود پیست کنم ! ممنونم میشم این قسمت هم راهنمایی کنید

[Skynet]

باسلام و احترام

iranweld

عزیز
خیلی خیلی ممنونم از کد عالیتون در بسیاری از فایل های در دست می تونم استفاده کنم متشکرممم.
فقط یک نکته مونده که ظاهرا جامونده
یکی از مشکلاتم اینه که چطور بعد از کپی اطلاعات از شیت A به شیت home، حالا بیام اطلاعات فیلتر شده در شیت B رو هم کپی کرده و بیام شیت home زیر اخرین سطر موجود پیست کنم ! ممنونم میشم این قسمت هم راهنمایی کنید

من برنامه نویسی نمی دونم ولی سعیمو کردم با توجه به کد شما ، کپی از شیت B به HOME هم اضافه کنم ولی ارور میده !

Sub Macro5()

'copy sheet A to HOME
z1 = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row


For i = 2 To z1
If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then


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


Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)






'copy sheet B to HOME
z11 = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row


For n = 2 To z11
If Sheets("B").Rows(n & ":" & n).EntireRow.Hidden = False Then


Sheets("B").Range("B" & n & ":j" & n).Copy Destination:=Sheets("Home").Range("C" & z2)




End If
Next


End Sub

[iranweld]

کد دستوری z2 را در کدی که نوشتید ، فراموش کردید اضافه کنید

[Skynet]

کد دستوری z2 را در کدی که نوشتید ، فراموش کردید اضافه کنید

میشه لطفا بیشتر توضیح بدین

[iranweld]

با سلام

از دو دستور if با یک End if استفاده کرده اید که سیستم ارورر میده.
کد اصلاح شده:

Sub test()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To za

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next


zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row

For i = 2 To zb

If Sheets("B").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("B").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next

End Sub 

[Skynet]

با سلام

از دو دستور if با یک End if استفاده کرده اید که سیستم ارورر میده.
کد اصلاح شده:

Sub test()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To za

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next


zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row

For i = 2 To zb

If Sheets("B").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("B").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

End If

Next

End Sub 

با سلام و احترام
بی نهایت ممنونم، این کد برای من حکم شاه کلید رو داره و در بسیاری از جاها می تونم ازش به بهترین نحو ممکن استفاده کنم. خیلی خیلی ممنونم از شما

به لطف شما ، کد نهایی با توجه به فایل ارسالی ، با کمی تغییر نهایتا به این صورت در اومد :

Sub test()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row


For i = 2 To za


If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then


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


Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)


End If


Next




zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row


For i = 2 To zb


If Sheets("B").Rows(i & ":" & i).EntireRow.Hidden = False Then


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


Sheets("B").Range("B" & i & ":B" & i).Copy Destination:=Sheets("Home").Range("c" & z2)
Sheets("B").Range("D" & i & ":G" & i).Copy Destination:=Sheets("Home").Range("G" & z2)




End If


Next


End Sub

یه سوال:
امکانش هست طوری دستور رو بنویسیم که در انتهای پیست کردن اطلاعات برای اطلاعات ارسالی از شیت A ، در ستون توضیحات عدد 1 رو تایپ کنه و برای برای اطلاعات ارسالی از شیت B ، در ستون توضیحات عدد 2 رو تایپ کنه مثل تصویر زیر :

[iranweld]

با سلام

فرضا اگر ستون توضیحات j باشد : Sheets("Home").Range("j" & z2) = 1

Sub test()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To za

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

Sheets("Home").Range("j" & z2) = 1

End If

Next


zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row

For i = 2 To zb

If Sheets("B").Rows(i & ":" & i).EntireRow.Hidden = False Then

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

Sheets("B").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

Sheets("Home").Range("j" & z2) = 2

End If

Next

End Sub 

[Skynet]

با سلام و احترام
بی نهایت ممنونم بهتر از این نمیشد عالییییی مرسییی