ادغام چند شیت

[Nimad]

سلام دوستان من یک فایل اکسل دارم که 200 شیت داره، اطلاعات از لحاظ ستون و ردیف ها یکسان هست، میخوام این شیت ها را در یک شیت ادغام کنم و هم پشت سر هم باشد، ممنون میشم راهنماییم کنید.
سپاس فراوان

[iranweld]

با سلام


ماکرو ذیل را تست بفرمایید.
تمامی اظلاعات شیتهای دیگر در شیت data کپی میگردد.

Sub test()

Application.ScreenUpdating = False

For Each Sheet In Worksheets

If Sheet.Name <> "data" Then

Sheet.Select

ActiveSheet.UsedRange.Copy

Sheets("Data").Select

Z1 = Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row + 1

Range("A" & Z1).Select

ActiveSheet.Paste


End If

Next

Application.ScreenUpdating = True

Range("A1").Select

MsgBox " Copy Finished."

End Sub 

[Nimad]

سپاس از راهنمایتان
ممنون میشم نحوه اجرای ماکرو را توضیح دهید.

[aliusefi]

با سلام اتفاقا بنده نيز با چنين مشكلي مواجهم و نياز دارم اطلاعات چند شيت را در يك شيت جمع كنم ولي نحوه اجراي ماكرو را نمي دانم در صورت امكان كاربر حرفه اي عزيز پاسخ دهند با تشكر

[iranweld]

با سلام

در فایل خود یک شیت جدید اضافه کنید و نام آنرا به data تغییر دهید

از منوی Developer و گزینه view code یک Module اضافه کنید و در داخل این ماژول کدهای ذیل را اضافه کنید




در صورتیکه آیتم developer را در منوی خود ندارید مراحل تصویر پیوست را انجام دهید

Sub test()

Application.ScreenUpdating = False

For Each Sheet In Worksheets

If Sheet.Name <> "data" Then

Sheet.Select

ActiveSheet.UsedRange.Copy

Sheets("Data").Select

z1 = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row + 1

Range("A" & z1).Select

ActiveSheet.Paste


End If

Next

Application.ScreenUpdating = True

Range("A1").Select

MsgBox " Copy Finished."

End Sub 

در شیت data با توجه به تصویر پیوست یک باتن اضافه کنید و ماکرو test را به آن اختصاص دهید






حال با کلیک بر روی باتن فوق ماکرو اجرا شده و محتویات شیت های دیگر را در این شیت کپی مینماید