حسين مامون

جرب المرفق
الفاتورة الرئيسيه (3).xlsm

وعليكم السلام ورحمة الله
الاخ محمد عبد السلام
ما المقصود بانشاء شيت2 وترحيل نفس البيانات لي في شيت1 هل ممكن توضيح ؟
اضافة اشياء اخرى للكود لا نحتاجها  قد يثقل عمل الكود
اضف هذه السطور اسفل الجزء الذي يرحل الى شيت1
Dim wss2 As Worksheet Set wss2 = wx.Sheets("sheet2") Dim lr2 lr2 = wss2.Range("a" & Rows.Count).End(xlUp).row + 1 If ws.[f5].Text = "اجل" Then wss2.Range("a" & lr2).Value = Nam wss2.Range("a" & lr2).Font.Color = 255 wss2.Range("b" & lr2).Value = "اجل" Else: wss2.Range("a" & lr2).Value = Nam wss2.Range("b" & lr2).Value = "نقدي" End If  

جرب المرفق لعله يفي بالغرض
المصنف1( (1).xlsm

جرب المرفق
 
شهر10.xlsm

عليكم السلام
جرب هذا التعديل 
ولكن مذا عن استعراص البيانات في الفورم ؟
سيأتر هذا عن ذلك وستضطر لتعديل الفورم
Private Sub CommandButton1_Click() Dim ws As Worksheet Set ws = ActiveWorkbook.Sheets("invoice") Dim wss As Worksheet Set wss = ActiveWorkbook.Sheets("Sheet1") Dim DT Dim Nam Dim lr As Long Application.ScreenUpdating = False Application.EnableEvents = False lr = wss.Range("a" & Rows.Count).End(xlUp).Row + 1 DT = ws.Range("e5") & Format(Now(), " ss - mm - hh - yyyy - mm - dd ") With ws Application.DisplayAlerts = False Nam = .Range("e5") & " " & Format(Now(), " ss - mm - hh - yyyy - mm - dd ") ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm" ' '========================================= End With If ws.Range("F5").Value = "نقدي" Then Else: wss.Range("a" & lr).Value = ws.Range("e5") wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ") wss.Range("C" & lr).Value = "اجل" End If If ws.[f5].Text = "اجل" Then Else: wss.Range("a" & lr).Value = ws.Range("e5") wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ") wss.Range("C" & lr).Value = "نقدي" End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub  

السلام عليكم
سبب مشكلتك اظن هذا الكود فعندما تنتقل الى شيت "ملاك" ينشط الكود ويلغي عملية اللصق
Private Sub Worksheet_Activate() ScreenOn End Sub Sub ScreenOn() Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub  

السلام عليكم
بعد اذن الاستاذ
جرب تغيير بسيط في الكود اضف "Value" الى textbox1 و textbox2 
.Range("A" & lastRow).Value = TextBox1.Value .Range("B" & lastRow).Value = TextBox2.Value
مثال.xlsm

تفضلي
99999999999999999999999999999999999.xlsm
وهذا من 5 الى 2
99999999999999999999999999999999999.xlsm

اخي الكريم 
لديك امتداد الملفات المخزنة في المجلد هو :xlsm وفي الكود xlsx 
اخل الى الكود وحول الامتداد من
File = Dir(Path & "*.xlsx*") الى
File = Dir(Path & "*.xlsm*") وسيعمل بحول الله وقوته

بعد اذن الاستاذ عبدالفتاح في بي اكسيل
واثراء للموضوع جرب هذه الطريقة
اليك هذا الماكرو
Sub pastespcolwid() ' Keyboard Shortcut: Ctrl+q ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste End Sub ضعه في مديول
ثم اهب الى Macro ثم  Options ثم ادخل حرف Q لاختصار الماكرو انظر الصورة  
الماكرو ينفذ عملية اللصق عن طريق لوحة المفاتيح والطريقة هي : حدد النطاق الذي تريد ثم نسخ ثم اذهب الى مكان اللصق ثم على لوحة المفاتيح اضغط زر CTRL+Q

وهذا المرفق
 
Book1.xlsm

اتمنى ان يكون ما تريد في هذا العمل 
stok.xlsm

بعد اذن استادي  ابراهيم الحداد
هذا المرفق
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i i = 1 For Each Sh In Sheets 'يمكنك تغيير اسماء الشيتات التي لا تريد ترقيمها If Sh.Name <> "Sheet1" And Sh.Name <> "Sheet2" And Sh.Name <> "Sheet3" And Sh.Name <> "Sheet4" Then Sh.Range("A1").Value = i i = i + 1 End If Next End Sub  
test.xlsm

انظ الصورة ادا كان البارتشن :C كما في الصورة فيمكن ان يعمل المشكلةدي
حدثت معي ذات مرة وقمت بنقل بعض محتويات من :C الى:D وفتح البرنامج عادي

بعد اذن استاذنا وجيه شرف الدين
واثراء للموضوع
اليك المرفق ولكن بكود VBA
ادخل قيمة البحث في الخلية b1 
test.xlsm

جرب المرفق
ملاحظة: يجب ان يكون التاريخ في الصفحات من الاصغر الى الاكبر 
            وكذلك يجب ان يكون تنسيق التاريخ هكذا مثلا 02/03/2020
         
تجميعه.xlsm

الحمد لله  ان تم الامر على خير
بالنسبة لطلبك من الاحسن انشاء textbox لادخال باس الحماية واخر لالغائه وهكذا يمكن جعل الكتابة بدل ارقام او حروف شكل اخر 
جرب المرفق
تعديل كود حماية الصفحات-1 (2).xlsm

تفضل 
Increment (1).xlsm

ربما يكون طلبك في المرفق
 
تغيير بيانات العاملين في كل الشيتات مرة واحدة على اساس رقم الكود.xlsm

اعتذر اخي وقع خطأ
تفظل
 
hr2.xlsm

رما يكون في التعديل ما تقصد
 
_سجل حضور وانصراف.xlsm

بعد اذن الاستاذ واتراء للموضوع يمكنك استخدام الكود التالي في حدث ورقة العمل
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim rng Dim lr lr = Cells(Rows.Count, 1).End(3).Row Set rng = Range("a3:a" & lr) If Not Intersect(Target, rng) Is Nothing Then Range("j3:j" & lr).Formula = "=B3&"" ""&C3&"" ""&D3&"" ""&E3" Value = Value End If End Sub  

اخي الكريم جرب المرفق
خطا في كود حد الصفحة (1).xls

اليك المرفق
قم بفك الضط وضع الفولدر REVI في :c
الفولدر REVI تجد فيه الملف الرئيسي  "تقويم" وفلدر "vi" لتخزين استمارات
قم بتجربة بعد اضافة عميل او ثلاثة وابدي رأيك 
اتمنى ان تجد فيه غايتك
REVI.rar

تفضل 
بحث من خلال الكمبو بوكس (1).xlsm

اعتذر اخي لتأخري في الرد
جرب المرفق
عد الكومبوبكس الممتلئة.xlsm