اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ادخال اسم فى صفحة وحفظه فى خلية صفحة أخرى


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

السلام عليكم ورحمة الله وبركاته

يعطيكم الف عافيه ياشباب

ارجو التكرم على مساعدتى فالأمر صعب جدا بالنسبة لى

الطلب

اريد ان اعمل خانه اسجل بها اسم في صفحه وتحفظ هذا الاسم في صفحة ثانية مع العلم الصفة الاولى تكون ثابته يعني مثال

الاسم : ابو خالد وتكون فيه ايقونة حفظ عند الظغط عليها يختفي الاسم ويحفظ في صفحة ثانية ويكون مربع الاسم متاح لكتابة اسم ثاني 

( ادخال بيانات بدون تغيير المربع

اعرف اني طولت عليكم في الشرح لاني لا اعرف كيف اجعل المعلومة تصل اليكم وان شاء الله تكون قد وصلة

شاكر ومقدر لكم جميعا

رابط هذا التعليق
شارك

  • أفضل إجابة

حسب ما فهمت من السؤال ربما يكون هذا الملف نموذج عما تريد

اذا ادركت  انك ادرجت اسماً بالخطأ اضغط على الزر Undo

كلما ضغطت مرة على Undo تستطيع أن تمسح اخر تسجيل في الصفحة الثانية

اذا اردت مسح كل البيانات من الصفحة الثانية اضغط على الزر Clear Data

 

Direct to Other_Sheet.xlsm

  • Like 3
رابط هذا التعليق
شارك

هذا هو الكود المستخدم كما اخبرك الأستاذ سليم -الأمر في غاية البساطة فيمكنك تتبع هذا الكود وفهمه

Option Explicit

Sub Save_for_Me()
Dim answer As Byte
Dim M As Worksheet: Set M = Sheets("Main")
Dim F As Worksheet: Set F = Sheets("For_Save")
Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row + 1
Dim fnd As Range
Set fnd = F.Columns("A").Find(M.Cells(2, 1), lookat:=1)
 If Not fnd Is Nothing Then
    answer = MsgBox("هذه المعلومة موجودة" & Chr(10) & _
          " هل تريد المتابعة", 36, "Attention")
          If answer = 6 Then
            F.Cells(lrF, 1) = M.Cells(2, 1)
            F.Cells(lrF, 2) = Date
            F.Cells(lrF, 3) = Time
            Exit Sub
          End If
  Else
    F.Cells(lrF, 1) = M.Cells(2, 1)
    F.Cells(lrF, 2) = Date
    F.Cells(lrF, 3) = Time
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim F As Worksheet: Set F = Sheets("For_Save")
Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row
If Target.Address = "$A$2" Then
 Save_for_Me
  lrF = F.Cells(Rows.Count, 1).End(3).Row
  If lrF = 1 Then GoTo End_Me
  Sheets("Main").Cells(2, "G").Resize(, 3).Value = _
  F.Cells(lrF, 1).Resize(, 3).Value
 End If
End_Me:
 Application.EnableEvents = True
End Sub
Sub Undo_for_me()
Dim F As Worksheet: Set F = Sheets("For_Save")
Application.EnableEvents = False
 Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row
  If lrF = 1 Then GoTo End_Me
  F.Cells(lrF, 1).Resize(, 3).ClearContents
  lrF = F.Cells(Rows.Count, 1).End(3).Row
  Sheets("Main").Cells(2, "G").Resize(, 3).Value = F.Cells(lrF, 1).Resize(, 3).Value
End_Me:
Application.EnableEvents = True
End Sub
Sub Clear_all()
Application.EnableEvents = False
 Dim F As Worksheet: Set F = Sheets("For_Save")
 Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row
 Dim answer As Byte
 answer = MsgBox("أنت تقوم بمسح كل البيانات في الصفحة For _save " & Chr(10) & _
          " هل انت متأكد من هذا", 1048628, "Attention")
          If answer <> 6 Then GoTo End_Me
 If lrF = 1 Then lrF = 2
 F.Cells(2, 1).Resize(lrF - 1, 3).ClearContents
 Me.Cells(2, "G").Resize(, 3).ClearContents
End_Me:
 Application.EnableEvents = True
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information