[حل شده] مشکل در ارتباط بین شیتها با ماکرو در اکسل

[taocom52]

سلام استاد و دیگر دوستان
من در یک فایل اکسل 20 شیت دارم (که اطلاعاتی از چند فایل دیگر به آنها ارسال میشود) حال میخواهم ماکرویی در شیت اول بنویسم که در شیتهای بعدی ستون 6 تا 10 هر شیت را کپی کرده و مقدار عددی ان را (value)در ستونهای 1 تا 4 همان شیت پست کند به عبارتی با فعال کردن ماکرو در شیت اول در 19 شیت بعدی این کار انجام شود من ماکرو را برای 3 شیت بعنوان مثال ظبط کردم ولی در انتقال به اولین شیت موقع اجرا اشکال میگیرد ، البته چون از نام فارسی برای شیتها استفاده کردم در اینجا بصورت اسکی افتاده:
Sub Macro2()'
' Macro2 Macro
'


'
Sheets("˜á").Select
Columns("K:O").Select
Selection.Copy
Columns("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1").Select
Application.CutCopyMode = False
Sheets("˜Çäí ÝáÒí").Select : اینجارا اشکال میگیرد که مرحله انتخاب شیت بعدی در ماکرو هست
Columns("K:O").Select
Selection.Copy
Columns("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F2").Select
Application.CutCopyMode = False
Sheets("˜ÇÛÐ").Select
Columns("K:O").Select
Selection.Copy
Columns("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F4").Select
Application.CutCopyMode = False
End Sub
باتشکر از راهنماییتان

[iranweld]

با سلام

این ماکرو را تست بفرمایید با دستور for each sheet in worksheets دیگر نیازی به انتخاب تک تک شیت ها توسط شما نمیباشد

Sub Macro2()

For Each Sheet In Worksheets

Sheet.Select
Columns("K:O").Select
Selection.Copy
Columns("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1").Select
Application.CutCopyMode = False

Next Sheet

Sheet1.Select

End Sub 

یا خیلی ساده تر

Sub Macro2()

For Each Sheet In Worksheets

Sheet.Columns("A:E").Value = Sheet.Columns("K:O").Value

Next Sheet

End Sub 

[taocom52]

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

[iranweld]

با سلام

کدها اصلاح گردید. فقط بایستی مشخص نمایید که قبل از انتقال داده های جدید، وقتی مقدار سلول مبدا صفر باشد ، داده های قبلی در سلول مقصد بایستی پاک شود یا نه؟

Sub test2()

Dim RNG, CELL As Range

Dim SH As Worksheet

i = 1

For Each SH In Worksheets

SH.Select

K = Sheets(i).UsedRange.Rows.Count

Set RNG = Sheets(i).Range("K1:O" & K)

i = i + 1

For Each CELL In RNG

If CELL.Value <> 0 Then

CELL.Offset(0, -10).Value = CELL.Value

End If

Next

Next

Sheet1.Select

End Sub 

[taocom52]

متشکرم از جوابتان با جوابی که فرمودید متوجه شدم باید سئوالم را بطور دقیق مطرح کنم تا راهنمایی کاملی ازتان بگیرم : در واقع من فایلی دارم که 20 شیت دارد و در شیت اول آن میخواهم ماکرویی بنویسم که اطلاعات داخل یک فایل دیگری را از مسیر مشخصی مانند c:/folder1 را کپی کرده و مقدار value آن را در شیتهای هم نامی که از ان فایل در این فایل باز کردم (برای هریک از بیست شیت ) پست نماید چون فایل مرجع هر روز باید آپدیت شود لذا یک کار تکراری طاقت فرساییست اگر ماکرو ننویسم . البته موضوع پاک کردن صفر ها بخاطر فرمولی مطرح کردم که میباید برای هرشیت بنویسم که بعد از حل این موضوع در مورد آن نیز راهنمایی خواهم خواست. بینهایت متشکرم

[iranweld]

با سلام

کاملا درست است اگر همان اول سوال خود را کامل و واضح بیان کنید این وقتیکه که برای پاسخگویی به هر سوال صرف میگردد با یکبار پرسش هم شما به جواب خود میرسید و هم دوستان وقت کمتری برای هر مرحله تغییر سوال صرف مینمایند.

الان هم بهتر است شما یک نمونه از فایل مبدا و مقصد را در سایت ضمیمه کنید که در فایل مقصد مشخص باشد قصد دارید در یک شیت همه دیتا جمع آوری گردد یا در هر شیت بایستی مشابه شیت مبدا باشد.

[taocom52]

سلام استاد بارهم پوزش میطلبم :
1- من دوتا فایل ارسال میکنم که یکی فایل مبدا ،پوشه ای با حدود 500 فایل اکسل هست که من فعلا 20 فایل را نیاز دارم وداخل ان گذاشتم تا برای ارسال هم سنگین نشه و فایل مقصد یک فایل اکسل هست که 20 کاربرگ هم اسم فایلهای مبدا دارد که بنده بطور دستی با کپی پست از فایل مبدا تمام اطلاعات داخل فایل مبدا را به هر یک از شیتها ی متناظرمنتقل کرده ام و در داخل هر شیت با ماکرویی که قبلا راهنمایی کردید مقدار عددی هریک را به ستونهای a تا e منتقل کرده ام چون فایل مبدا هر روز آپدیت میشود و تعدا سطرهای آن تغییر میکند لذا مجبور شدم کپی پست را تا 600 سطر گسترش بدم که حتما اطلاعت را پوشش دهد ولذاینکار علاوه برسنگین کردن فایل با عث تولید سطرهایی با محتوای فرمول (که تبدیل به 0 کردم) شده که باعث میشود نرم افزاری که این اطلاعات را دریافت خواهد کرد دچار مشکل شده و نتواند آنالیز کند حال ماکرویی میخواهم که اینکار را انجام دهد یعنی تمام اطلاعات فایل متناظر مبدا را به شیت هم نامش به صورت value (با همان سطر و ستونی که در فایل مبدا هست) منتقل کند و اگر فردا اپدیت شدوتعداد سطرها زیاد شد مشکلی پیش نیاید.
2 - اگر در فایل مقصد توجه فرمایید کنار هر شیتی که از فایل مبدا اطلاعات را گرفته یک شیت دیگر ایجاد کردم که با همان نام به اولش کلمه "قدرت" اضافه شده که در این فایل نیز یک فرمول ساده با استفاده از شیت اصلی کناریش اطلاعاتی را درست میکند که موضوع سطره و 0 بودن یا فرمول بودن سطرهای غیر خالی مشکل ساز است که راه حل حضرتعالی کارگشا خواهد بود.
بسیار متشکرمu

[iranweld]

با سلام

در صورتیکه هر شیت مبدا به انتهای شیت های مقصد با ماکرو منتقل گردد کمکی به شما مینماید؟

[taocom52]

ببخشید متوجه نشدم ، منظور از انتهای شیت چیست ، آنچه لازم است این است که محتوای شیت مبدا به شیت مقصد منتقل شود و در همان ستونهایی که در شیت مبدا هست (a تا e) در شیت مقصد باشد و یا اینکه اصلا فایلهای مبدا که هر یک فایل اکسل هستند با همان نام بعنوان یک کاربرگ به فایل مقصد با تمام محتویاتشان منتقل شوند البته نمیدانم امکان پذیر هست یا نه بعبارتی چند فایل اکسل را در یک شیت با همان نامها جمع اوری کنیم.
متشکرم

[iranweld]

با سلام

فعلا فایل و پوشه پیوست را در درایو D کپی نمایید و فایل import-sheets را اجرا کنید و سپس بر روی باتن تعبیه شده کلیک نمایید و در پنجره INPUTBOX همان مسیر را OK کنید

هر شیت فایل مبدا بصورت یک شیت با نام فایل اکسل مبدا به انتهای شیت های مقصد اضافه میگردد

[taocom52]

عالی بود متشکرم ، فقط وقتی به این فایل مسیر اصلی که نرم افزار ما داده ها را تولید کرده میدم تمام 500 فایل اکسل رو که تولید کردیم را میاره که کار را خراب میکنه چطوری میشه گفت که چند فایل بخصوص را اینکارو بکنه مثلا یک کاربرک در فایل مقصد داشته باشیم که در ستون اول نام فایلهایی را که میخواهیم معرفی کنیم و import روی آن اسامی این عملیات را انجام بده و هربا که آپدیت میکنیم شیتی جدید را روی شیتها قبلی همنام بزن نه آینکه اضافه کنه چون بعد چند روز هزاران کاربرگ تولید میشه که درست نیست که اگه بشه مشکلات بعدی نرم افزار ماهم حل میشه

قبلا از همه حوصله و وقتی که میزارید ممنونم
راستی استاد چطوری vba فایلی که برام فرستادید رو ببینم ؟

[iranweld]

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

برای هر بار Import فایل ، شیتهای اضافه شده قبلی ابتدا حذف میگردد (هر شیتی که در ابتدا یا انتها شامل عدد باشند)بنابر این با گذشت زمان تعداد شیت ها افزایش پیدا نمیکند.

فعلا فقط فایلهای مورد نظر برای import را در فولدر test قرار دهید تا کدهای مرحله بعدی آماده گردد

Private Sub CommandButton1_Click()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each sheet In Worksheets
sheet.Select
If IsNumeric(Left(sheet.Name, 1)) Or IsNumeric(Right(sheet.Name, 1)) Then
ActiveSheet.Delete
End If
Next

directory = InputBox("مسیر فولدر مورد نظر را وارد کنید", vbNewLine, "D:\test\")

If directory = "" Then GoTo 0

fileName = Dir(directory & "*.xls")

Do While fileName <> ""

 Workbooks.Open (directory & fileName)
 
    For Each sheet In Workbooks(fileName).Worksheets
        total = Workbooks("import-sheets.xlsm").Worksheets.Count
        Workbooks(fileName).Worksheets(sheet.Name).Copy _
        after:=Workbooks("import-sheets.xlsm").Worksheets(total)
        
  ActiveSheet.Name = Left(fileName, Len(fileName) - 4)
                
    Next sheet
        
    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

0

End Sub 

[taocom52]

استاد من فایل رو کامل امتحان کردم ، بله فایلهای بعد از آپدیت شدن زیاد نمیشوند اما اگر فایل مقصد را مشاهده کرده باشید کنار هر کاربرگ کاربرگی را ایجاد کرده ام با همان نام ولی اولش کلمه "قدرت" دارند ،این کاربرگها در فایل مبدا نیستند و در فایل مقصد ثابت هستند که بعد از کپی فایلها از مبدا به مقصد با استفاده از فایل های ایجاد شده بر اساس فرمول ساده ای مثلا در شیت قدرت کانی در سلول d طبق فرمول زیر
=IF('شاخص كل6'!D2>0;('13-كانه فلزي6'!D2/'شاخص كل6'!D2)*100;"0") اطلاعاتی را از فایلهای ایجاد شده کد شما می گیرند و حاصلی را میدهد ولی وقتی من فرمول شیتهای قدرت را بر اساس فایلهای استخراجی کد شما تغییر دادم دوباره که از فایل import استفاده کردم در سلولهایی که از فرمول استفاده شده است(کاربرگهای قدرت) خطای رفرنس داد و فرمول محاسبه نکرد گویی کاربرگهای جدید آدرس دیگری دارند در حالی که در کد شما کاربرگها با همان نام مشخص تولید میشوند و در فرمول بنده هم از همان نام مشخص کاربرگ استفاده شده ولی متاسفانه فرمول کار نمیکند شاید علت آنست که کاربرگهای جدید روی کاربرگهای قبلی کپی نمیشوند بلکه ماهیتا کاربرگ دیگری هستند که تولید میشوند و فرمول اسم آنها را نمیتواند شناسایی کند!!!

[iranweld]

با سلام

با استفاده از Indirect مشکل حل شد

بر روی سه شیت فرمول اصلاح شد

[taocom52]

سلام استاد با کمک حضرتعالی تونستم برنامه رو بنویسم و همه قسمتهای ان هم درست کار کرد ولی یک مشکل عجیب و ابتدایی پیش آمده تعدادی از شیتهایی که سلولهای آنها را مساوی سلولهایی در یک فایل دیگر قرار داده ام قاعدتا هنگام باز شدن فایل میباید آپدیت شوند ولی تعدادی از آنها آپدیت نمیشوند فکر میکنید اشکال از کجا میتونه باشه؟ نمونه کوچکی از فایل مقصد و فایل مبدا را براتون ارسال میکنم فایل مبدا هر روز توسط سایت بورس بروز رسانی میشود , و محل آن را در درایو c قراردادم که در هر کامپیوتری آدرس یکسانی داشته باشد ، لذا میبایست در فایل مقصد هم آخرین سطر ستون k مطابق فایل مبدا تاریخ 941005 میشد ولی آپدیت نمیشود.
سئالم را اشتباها مجدد در پایین تکرار کردم و فایلهای پیوست را ارسال کردم متشکرم