فرستدن ردیف های از یک شیت به شیت دیگر در همان ورکبوک

[shitelsz]

فرستدن ردیف های از یک شیت به شیت دیگر در همان ورکبوک

سلام دوستان�
من تازه عضو شدم و یک راهنمای می*خواستم.
من یه پروژه دارم که باید انجام بدم. برای این پروژه من یک ورکبوک درست کردم.

این ورکبوک چندین شیت داره. من لازم دارم که اطلاعات رو ( یک ردیف کامل ) رو به یک شیت دیگه توی همون ورکبوک منتقل کنم. این انتقال زمانی* انجام خواهد شد که استتوس ( وضعیت ) اون ردیف از حالتی به حالت دیگه تغییر کنه و بعداز تغییر باید به صورت اتوماتیک اون ردیف از شیت در حال هز کات ( منتقل) بشه و به شیت مربوطه در انتهای شیت انتقال پیدا کنه.

موتمنم که یه کد وبا باید واسعش نوشته بشه ولی* من هیچ اطلاعاتی در این زممینه ندارا.

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

[Ali Parsaei]

سلام،
فايلتان خيلي شلوغ است! دقيقا" از کدام شيت به کدام شيت بايد کپي شود!؟
من مسئله را به صورت ساده اينطور بيان مي کنم:

1-يک فايل فرضي اکسل با دو شيت داريم
2-مي خواهيم يک رديف از شيت يک را ويرايش کرده و در آن اطلاعات درج کنيم
3-بعد ار خاتمه ويرايش، رديف مربوطه کات و به شيت دو (در آخرين رديف خالي) منتقل شود.

منظورتان همين است؟
در اين صورت بايد از کد نويسي در محيط vba اکسل استفاده کرد
چيزي از vba مي دانيد؟ آيا حل مشکل به اين طريق به دردتان مي خورد؟

[shitelsz]

بله کاملا درست متوجه شدین اقای پارسا. راستش من با کد نویس vba اشنا نیستم. ممنون میشم اگه که بتونین کمکی در این زمینه بهم بکنن

[iranweld]

بله کاملا درست متوجه شدین اقای پارسا. راستش من با کد نویس vba اشنا نیستم. ممنون میشم اگه که بتونین کمکی در این زمینه بهم بکنن

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

[nikkhah]

سلام
ببخشید یه فیلم آموزشی از بایگانی پیدا کردم فکر کنم مشکل شما حل شود .
البته فیلم آموزشی از زحمات آقای فرشید میدانی میباشد که دارای 3 قسمت میباشد ،منظور شما قسمت آخر فیلم میباشد .
موفق و پایدار

http://uploadkon.ir/fl/d/NzI0OTU%3D

[shitelsz]

سلام دوستان.

ممنونم از راهنمایهاتون.
بعنوان مثال از شیت اپن با تغییر وضعیت اون کیس اپن, در ستون (استوس) مثلا به ین پرگرس, اون ردیف کلا منتقل بشه به انتهای شیت این پروگرس.

امیدوارم توضیح کامل باشه.

ممنون نیکخواه جان رفتم خونه حتما چک می کنم.

[iranweld]

با سلام
فایل پیوست با vb تهیه گردید
ملاحظه بفرمایید

[shitelsz]

ممنون iranweld عزیز چک میکنم و اگر سوالی داشتم دوباره مزاحم میشم. ممنون از کمکیت...

[iranweld]

ممنون iranweld عزیز چک میکنم و اگر سوالی داشتم دوباره مزاحم میشم. ممنون از کمکیت...

فقط یک مشکل وجود داره و اینکه چند تا سطر رو با هم منتقل میکنه
از دوستان کسی میتونه این مشکل رو رفع کنه ؟

[shitelsz]

سلام ممنون.
بله این اشکالو داره که چنتا لین رو باهم می*فرسته در بعضی* مورد.
کسی* از دوستان می*تونه این مشکل رو حل کنه ؟

[iranweld]

سلام ممنون.
بله این اشکالو داره که چنتا لین رو باهم می*فرسته در بعضی* مورد.
کسی* از دوستان می*تونه این مشکل رو حل کنه ؟

مشکل برطرف شد

[shitelsz]

سلام دوست من خیلی* ممنونم..
من سعی* کردم یه سری چیزا رو تغییر بدم به اون روشی* که دارم تغییر میدم ولی* متاسفانه نتونستم خوب پیش برم. می*شه لطفا یه تمپلیت چیزی واسعم تهی کنی* که من بتونم استفاده کنم که دیگه موزهم شما نسهام علاوه بر اون یه مشکلی* پیدا کردم توی این سپرید.
زمانی* که کل ردیف رو به شیت دیگه انتقال میده*??� مایل هستم که استتوس جدید توی اون شیت جدید به صورت پیش فرض باقی* بمونه ( یعنی* اینکه استتوس از شیت قبلی* به شیت جدید انتقال پیدا نکنه).

الان کاملا بتن به عنوان یک مثل توضیح میدم.
ماسلن اگه علی* از شیت اپن*??� ستتوسش عوض بش به این پروگرس*??� این ردیف بدون استتوس در حال هز منتقل بش به شیت مربوطه. چرا چونکه توی شیت مربوطه استتوس های جدید اونجا وجود داره.
ماسلن در شیت این پروگرس*??� استتوس می*تونه به چیزهای دیگه تغییر کنه که دوباره بر مبانی هر استتوس یه شیت هستش که لازم هستش به اون ردیف که از شیت اپن منتقل داده شده این*دفعه با استتوس جدید که توی این پروگرس میگیره به شیت مربوطه منتقل بشه و همینطور الی* آخر..

امیدوارم که توضیحات کافی* باشه...

[shitelsz]

این فایل درست هستش دوست من عذر می*خوام.

[Ali Parsaei]

شما کافي است اين کد را براي شيت OPEN بنويسيد:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
Dim D As Integer
Dim J As Variant
 If (ActiveCell.Row > 3 And ActiveCell.Column = 10) And (ActiveCell.Value = "In progress" Or ActiveCell.Value = "Complete") Then
    D = ActiveCell.Row
    J = ActiveCell.Value
    Rows(D).Cut
    Worksheets(J).Activate
       If Worksheets(J).Range("A4") = "" Then
          Worksheets(J).Range("A4").Select
         Else
          Worksheets(J).Range("A3").Select
          Selection.End(xlDown).Offset(1, 0).Select
       End If
    ActiveSheet.Paste
    Worksheets(J).Cells(ActiveCell.Row, 10).Value = ""
    Worksheets("Open").Activate
    Rows(D).Delete
 End If
End Sub 

و براي دو شيت ديگر هم همين کد را با تغيير اسامي شيت ها در کد مجددا" استفاده کنيد تا برعکس مطلب هم اجرا گردد.
من فايل پيوست را فقط با کد جهت شيت OPEN به عنوان مثال برايتان مي گذارم:

[shitelsz]

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