كود لفتح صفحة جديدة بإسم الفندق تلقائياً كلما تم ادخال اسم فندق جديد

[هانى محمد]

السلام عليكم أحبائى واساتذتى الكرام .. وكل عام وانتم بخير ,,, أتمنى منكم التكرم على مساعدتى لعمل كود لفتح شيت جديد تلقائياً  كلما تم ادخال اسم فندق جديد بالعمود C بصفحة Rooming List على ان تأخذ هذه الصفحة نفس تنسيقات صفحة Aqua Park HRG بأن يكون اسم الفندق بالخلية K2 للصفحة الجديدة ... ولكم جزيل الشكر وبارك الله فيكم <<<وهذا نموذج مصغر للملف الأصلى الذى قد يتعدى 4000 صف

Summer 2022 .xlsb

[omar elhosseini]

اخي 

يوجد اسماء مكررة فى عمود 

Hotel

فكيف يتم فتح شيت جديد في حالة تكرار الاسم

[هانى محمد]

بارك الله فيك استاذ عمر هذه الصفحة للإدخلات طوال العام وطبيعى ان يتكر اسم الفندق او وجود العديد من الحجوزات لنفس الفندق انا اريد فتح صفحة واحدة لهذا الفندق .بمعنى فتح صفحة للفندق فقط عند الإدخال لأول مرة بغض النظر عن تكرار ادخال هذا الفندق مستقبلاً وبالمعادلات سيتم ترحيل بيانات الفندق الى صفحته كما بصفحة Aqua Park HRG ,,, ولكم جزيل الشكر على ردكم

[omar elhosseini]

اخي شاهد المرفق

Test_1.xlsb

[هانى محمد]

أحسنت استاذ عمر وأحسن الله اليك  ... شكراً جزيلاً لجهود سيادتكم

ولكن تظهر معى رسالة خطأ عند ادخال نفس الفندق أكثر من مرة , فهل هناك حل لذلك ..فكما أخبرت حضرتك سلفاً ان هذا طبعاً وارد فربما يتم ادخال نفس اسم الفندق أكثر من 1000 مرة ؟!!وبناءاً لظهور هذه الرسالة يتوقف الكود عن العمل ولا يقوم بالمهمة المكلف بها حتى عند ادخال اسم فندق جديد لأول مرة لا يقوم بفتح صفحة له 

[أ / محمد صالح]

بعد إذن حبيبنا @omar elhosseini

يمكنك استعمال هذه الأكواد في صفحة Rooming list

كلك يمين ثم view code ثم تلصق هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row <= 2 Then Exit Sub
If Target.Column = 3 And Target.Value <> "" And Not (sheetExists(Target.Value)) Then
Call newsh(Target.Value)
End If
End Sub
Function sheetExists(sheetToFind As String) As Boolean
sheetExists = False
For Each Sheet In Worksheets
    If sheetToFind = Sheet.Name Then
        sheetExists = True
        Exit Function
    End If
Next Sheet
End Function
Sub newsh(newname As String)
OptimizeVBA 1
Sheets("Aqua Park HRG").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = newname
ActiveSheet.Range("K2") = newname
OptimizeVBA 0
End Sub
Sub OptimizeVBA(isOn As Boolean)
 Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
 Application.EnableEvents = Not (isOn)
 Application.ScreenUpdating = Not (isOn)
 ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub

وبه من كنوز مكتبتي الخاصة الكثير من التحف

التأكد من وجود اسم الشيت

تحسين سرعة الأكواد في vba

بالتوفيق

[هانى محمد]

أحسنت استاذ محمد بالفعل هذا هو المطلوب بفضل جهودكم بارك الله فيك وجزاك الله خير الثواب وأكرمك الله وأحسن الله اليك ..وكل عام وأنتم بخير

[أ / محمد صالح]

جميعا بإذن الله