طلب تعديل كود

[محمد عبدالسلام]

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

  طلبي  هو عن كود يقوم بترحيل اسم العميل/  تاريخ الفاتورة /نوع الفاتورة الى Sheet1

وأريد تعديل الكود ليقوم بترحيل  الى شيتين Sheet1 و Sheet2

 

Private Sub CommandButton1_Click()

Dim wx As Workbook
Set wx = Workbooks("فاتورة")

Dim ws As Worksheet
Set ws = wx.Sheets("invoice")
Dim wss As Worksheet
Set wss = wx.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(), "dd-mm-yyyy hh mm ss")
             With ws

                    Application.DisplayAlerts = False
                      Nam = .Range("e5") & " " & Format(Now(), "dd mm yyyy  hh mm ss")
                               ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm"
'
 '=========================================
                    If ws.[f5].Text = "اجل" Then
                    wss.Range("a" & lr).Value = Nam
                    wss.Range("a" & lr).Font.Color = 255
                    wss.Range("b" & lr).Value = "اجل"
                   Else: wss.Range("a" & lr).Value = Nam
                    wss.Range("b" & lr).Value = "نقدي"
                    End If
   '========================================
'                 ActiveWorkbook.Close False
              End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
                                        MsgBox "تم حفظ نسخة باسم " & DT & " ", vbInformation
End Sub

 

back.zip

[حسين مامون]

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

الاخ محمد عبد السلام

ما المقصود بانشاء شيت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

 

[محمد عبدالسلام]

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

 ما المقصود بانشاء شيت2 وترحيل نفس البيانات  في شيت1 

اماشيت واحد للفواتير لي مازال عليها دين وشيت2 كارشيف لجميع الفواتير اما اذا قمت بي انشاء شيت الاستعلام عن فواتيري لي علىها دين وشيت اخر كارشيف  تكون عمليه الاستعلام عن الفواتير بسرعه لان الفواتير علىها دين في شيت 1 قد تصل إلى عشره او 15 و 20 اما ورقه الارشيف قد تصل الى 1000 او 2000 

اما الفاتوره اذا تما تسديد دينها يتم ازالتها من شيت واحد وتبقى كارشيف في شيت اثنان

جزاكم الله عنا خير الجزاء، وأبعد عن قلوبكم الحزن والشقاء ،وجعلكم من السابقين فى الخيرات، وأدخل إلى قلوبكم سرور الطاعات ،وختم عملكم بالباقيات الصالحات

تم تعديل أكتوبر 13, 2020 بواسطه محمد عبدالسلام