حسين مامون

بالنسبة للطلبي 2 جرب الكود التالي  ضعه في Textbox1 فورم1
ادخل رقم الحساب وانقر زر انتر على لوحة المفاتيح
Private Sub TextBox1_AfterUpdate() Dim ws As Worksheet: Set ws = Sheets("ورقة1") Dim lr, x lr = ws.Cells(Rows.Count, 3).End(3).Row For x = 2 To lr If TextBox1.Text = ws.Cells(x, 3).Text Then TextBox2.Value = ws.Cells(x, 4).Value TextBox3.Value = ws.Cells(x, 5).Value TextBox4.Value = ws.Cells(x, 6).Value ComboBox1.Value = ws.Cells(x, 7).Value Exit For End If Next x End Sub وهذا في Combobox1
Private Sub ComboBox1_Change() Sheets("ورقة2").Range("j8").Value = Me.ComboBox1.Value End Sub  

عند ادخال اي نص او قيمة في الخليتين انقر زر Entr على لوحة المفاتيح وانظر 
وهذا الكود في حدث شنج
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = ("$F$4") Then Shapes.Range(Array("Rectangle 3")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Target ElseIf Target.Address = ("$F$5") Then Shapes.Range(Array("TextBox 4")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Target End If End Sub ربط مربع نص بدالة.xlsm

جرب ربما يكون ما تقصد
كشف حساب .xlsm

انسخ الكود والصقه مكان السابق
طبعا بعد اضافة ال فورم 2 و 3
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Application.ScreenUpdating = False On Error Resume Next If Target.Column = 4 Then ' = 4 And Target.Row > 9 Then UserForm4.Show ElseIf Target.Column = 5 Then UserForm3.Show ElseIf Target.Column = 6 Then UserForm2.Show End If End Sub  

اتمنى ان يكون ما تريد
Try VBA 64 for First time.xlsm

جرب المرقق
الرقم السري 123 في جميع الازرار
يمكنك تغييره في كل زر داخ الاكواد
 
انظر الصورة

Data-2021.xlsm

جرب المرفق
جدول 2.xlsm

جرب المرفق
تعديل فروم.xlsm

ربما يكون حل

تفضل
فاتورة(2)(6).xlsm

جرب المرفق
فاتورة(2).xlsm

جرب المرفق
حركات.xlsm

بعد رفع الملف فك الضغط واحفظ المجلد في اي فولدر 
ثم جربه
myDOS.rar

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim lr, x lr = Cells(Rows.Count, 1).End(3).Row If Not Intersect(Target, Range("a4:a" & lr)) Is Nothing Then For x = 4 To lr Cells(x, "d") = Cells(x, "a") & Format(Range("c2"), "mmyyyy") & "PS" Next x End If End Sub 01.xlsm

حاول تطبيق ما في الصورة
1 في نفس الصفحة يمكنك تطبيق ما في الصورة
2 في صفحة اخرى يمكنك عمل نفس الكود مع اي نطاق تريد

تفضل
نموذج اكسيل لشيت اضافة.xlsm

في المرة القادمة ارفع ملف مع شرح ما تريد بالتفصيل 
استعمل الكود التالي اذا كانت البيانات في العمود A
Sub TEST() Dim LR LR = Cells(Rows.Count, 1).End(3).Row If LR = 1 Then Exit Sub Range("a1:a" & LR).RemoveDuplicates Columns:=1, Header:=xlNo End Sub اليك الرابط التالي ربما تستفيد من مشاركات الاساتذة الافاضل
 

جرب المرفق
انظر التجربة بالصور عندي

 

المكتبه 1 (2).xlsm

جرب المرفق
نهائى شهدات محمد.xls

جرب المحاولة في المرفق لعلها ما تريد
44.xlsm

جرب المرفق
fik.xlsm

جرب المرفق
100.xlsm

استاد حسن البدوي 
لا اعرق لماذا تعيد نفس طلب مشاركة سابقة علما انني اجبتك في تلك المشاركة ولم تبدي اي رأي ، كان بالامكان طلب تعديل نفس المشاركة وتجنب اهدار وقتك و وقت الاعضاء
عموما اليك المرفق
اولا ادخل اسم العميل ثم البيانات الاخرى
ثانيا اضغط زر حفظ
ملاحظة : لا يمكن تكرار نفس العميل اكثر من مرة
تحياتي
الفاتورة الرئيسيه (3).xlsm

جرب المرفق
Sub serchsheet() Dim sh As Worksheet Dim rng As Range Set rng = Sheets("ÊÚÏíá_ÓÚÑ_ÇáÚãíá").Range("G2") Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Name = rng.Text Then sh.Visible = True sh.Activate Exit For End If Next sh Application.ScreenUpdating = True End Sub الفاتورة الرئيسية.xlsm

جرب هذا الماكرو لعله يفي بالغرض
Sub TRANS() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr1, lr2 Set ws1 = Sheets("جدول المبيعات") Set ws2 = Sheets("قائمة المبيعات") lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1 ws1.Range("b6:b" & lr1).Copy ws2.Range("b" & lr2) ws1.Range("c6:c" & lr1).Copy ws2.Range("e" & lr2) End Sub ترحيل.xlsm