جابه جایی بین شیت های قفل شده

[ali.b]

با سلام
من ی کد دارم که میتونین برای اموزش هم استفاده کنین که کل اون ردیف رو به شیتی که هم نام با سلول مورد نظر باشه انتقال میده
حالا شیت های من رمزشون 123 هست و میخوام این کد با اینکه شیت ها پروتکت شدن هم کارشو کنه اما هر کدی میزنم ارور میده نمیدونم مشکل از کجاست

Sub sabt()
'
' Macro2 Macro
'
Dim c As Range
For i = 1 To Sheets.Count
    For Each c In Sheet1.Range("I3")
        If c.Value = Sheets(i).Name Then
    Range("A3:H3").Select
    Selection.Copy
    Sheets(i).Activate
    Range("A3").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A3").Select
    Sheets("ËÈÊ").Select
    Range("A3:G3,I3").Select
Selection.ClearContents
Range("A3").Select
        End If
    Next c
Next i
End Sub

ممنونم میشم ی راه حلی نشون بدین

[ali.b]

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

کد میزنم به این گیر میده

[امين اسماعيلي]

با درود
خب وقتی شیتت پروتکت باشه همینه مشکل با select پیدا میکنی- شمو کد وارد شدن رمز رو که تو پست های اموزشی هم گذاشتی بزار اول کد هات بعد کد قفل شدن خودکارشونم بزار اخر کد هات حل میشه

[ali.b]

از قبل هم گذاشتم منظورتون این حالتیه؟

Sub sabt()
ActiveSheet.Unprotect "123"
Dim c As Range
For i = 1 To Sheets.Count
    For Each c In Sheet1.Range("I3")
        If c.Value = Sheets(i).Name Then
    Range("A3:H3").Select
    Selection.Copy
    Sheets(i).Activate
    Range("A3").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A3").Select
    Sheets("ËÈÊ").Select
    Range("A3:G3,I3").Select
Selection.ClearContents
Range("A3").Select
        End If
    Next c
Next i
ActiveSheet.Protect "123"
End Sub

اما گزینه

Selection.Insert Shift:=xlDown

مشکل پیدا میکنه

[Javid Mokhtari]

از قبل هم گذاشتم منظورتون این حالتیه؟

Sub sabt()
ActiveSheet.Unprotect "123"
Dim c As Range
For i = 1 To Sheets.Count
    For Each c In Sheet1.Range("I3")
        If c.Value = Sheets(i).Name Then
    Range("A3:H3").Select
    Selection.Copy
    Sheets(i).Activate
    Range("A3").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A3").Select
    Sheets("ËÈÊ").Select
    Range("A3:G3,I3").Select
Selection.ClearContents
Range("A3").Select
        End If
    Next c
Next i
ActiveSheet.Protect "123"
End Sub

اما گزینه

Selection.Insert Shift:=xlDown

مشکل پیدا میکنه

با سلام.
خب برادر من ، شیت های شما که قفل است و فرض کنید شما در شیت اول قرار دارید و شما در خط اول نوشتید ActiveSheet.Unprotect "123 این یعنی فقط شیت اول از قفل ازاد می شود و می توانید در ان شیت عملیات انجام دهید این از این.وقتی وارد حلقه می شوید کد Sheets("ËÈÊ").Select را نوشتید پس شیت فعال Sheet("ËÈÊ هستش ولی شما کدی برای Unprotect کردن شیت EEE ننوشته اید بخاط همین کدها خطا می دهد.
من فلسفه حلقه For Each رو نفهمیدم که تو کد بالا به چه دردی می خوره.کد اضافه زیاد نوشتید.

[ali.b]

فلسفه این کد در این هست که اگه در شیت 1 در سلول خاصی هر متنی بنویسی تمام اون ردیف رو به شیت هم نام سلول مورد نظر انتقال میده
پس برای هر شیتی که از رنج فلان تا رنج فلان هر متنی مطابق شیت های اکسل بود اطلاعات رو به اون شیت اضافه کن
و برای اینکه در ماژول تعریف بشه و برای هر شیت جداگانه قرار نگیره این حالت هست تا هرجا خواستم با ی call فراخوانی کنم

[ali.b]

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

[ali.b]

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

Sub sabt()
ActiveSheet.Unprotect "123"
Dim c As Range
For i = 1 To Sheets.Count
    For Each c In Sheet1.Range("I3")
        If c.Value = Sheets(i).Name Then
    Sheets(i).Activate
    ActiveSheet.Unprotect "123"
    Sheet1.Range("A3:H3").Copy
    Range("A3").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A3").Select
    ActiveSheet.Protect "123"
        End If
    Next c
Next i
    Sheets("ËÈÊ").Select
    Range("A3:G3,I3").Select
Selection.ClearContents
Range("A3").Select
ActiveSheet.Protect "123"
End Sub

[Javid Mokhtari]

فلسفه این کد در این هست که اگه در شیت 1 در سلول خاصی هر متنی بنویسی تمام اون ردیف رو به شیت هم نام سلول مورد نظر انتقال میده
پس برای هر شیتی که از رنج فلان تا رنج فلان هر متنی مطابق شیت های اکسل بود اطلاعات رو به اون شیت اضافه کن
و برای اینکه در ماژول تعریف بشه و برای هر شیت جداگانه قرار نگیره این حالت هست تا هرجا خواستم با ی call فراخوانی کنم

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

 For Each c In Sheet1.Range("I3")
        If c.Value = Sheets(i).Name Then 

با کد

        If Sheet1.Range("I3") = Sheets(i).Name Then 

هیچ فرقی ندارد.

[Javid Mokhtari]

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

[/CODE]

این مسلم است که پس از کپی کردن، هر عملی در شیت باعث لغو شدن عمل کپی می شود.

Dim c As Range
For i = 1 To Sheets.Count 
       If Sheet1.Range("I3") = Sheets(i).Name Then 
       Sheet1.Unprotect "123"  
      Sheets(i).Unprotect "123"  
  Sheets(i).Rows("3:3").Insert Shift:=xlDown
    Sheet1.Range("A3:H3").Copy
    Sheets(i).Activate
    Sheets(i).Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Sheet1.Protect "123"
        Sheets(i).Protect "123"
        End If
Next i 

بقیه کدهایی که میخواین رو اضافه کنید.اما به اولویت عمل دقت کنید.

[ali.b]

من فایل نمونه و یا کد نمونه رو گذاشتم و این فایل به 54 تا فایل اکسل اونم تحت شبکه و به نرم افزار pm تعمیرات هم مانیتور شده
و تمام رنج های سلولی که تو کد بحث شده خودشون از چندین کد و تابع های دیگه بدست میاد
پس نیاز به این نوع کد نویسی با توجه به چیزای دیگه ای تو برنامه من هست، رو داشتم
اما این تغییری که شما دادین تو ی فایل دیگه واقعا کارم رو راحت کرد ممنونم

[Javid Mokhtari]

من فایل نمونه و یا کد نمونه رو گذاشتم و این فایل به 54 تا فایل اکسل اونم تحت شبکه و به نرم افزار pm تعمیرات هم مانیتور شده
و تمام رنج های سلولی که تو کد بحث شده خودشون از چندین کد و تابع های دیگه بدست میاد
پس نیاز به این نوع کد نویسی با توجه به چیزای دیگه ای تو برنامه من هست، رو داشتم
اما این تغییری که شما دادین تو ی فایل دیگه واقعا کارم رو راحت کرد ممنونم

خب اگه کدتون مربوط به یک فایل دیگست و ایجاب میکنه که اینجوری کدنویسی بشه که هیچ.ولی منظور من این فایل بود.