JavaScript is not enabled!...Please enable javascript in your browser

جافا سكريبت غير ممكن! ... الرجاء تفعيل الجافا سكريبت في متصفحك.

-->
الصفحة الرئيسية

اكسل | الترحيل فى الاكسل الترحيل من اليومية الى اى عدد من اوراق العمل Excel VBA Transfer Data To Any Sheets

 بسم الله الرحمن الرحيم 
اهلا بكم متابعى موقع عالم الاوفيس

كود جديد من مكتبة اكسل ماكرو Excel VBA 

الترحيل فى الاكسيل ترحيل البيانات من اليومية الى اى عدد من اوراق العمل



فى هذا الكود من اكواد  اكسل ماكرو Excel VBA نتعلم بطريقة سهلة جدا كيفية ترحيل البيانات من اليومية الى اى عدد من اوراق العمل فى ملف الاكسل .

لو اننا عندنا يومية نقوم فيها يوميا بتسجيل حركات مدفوعات او مسحوبات العملاء او الاصناف ولكل عميل صفحة خاصة بة او ورقة عمل خاصة بة (Sheet) ونريد ان نقوم بترحيل هذة الحركات الى الشيت الخاص بكل عميل كل هذا سوف نعملة من خلال كود سهل جدا وبسيط وبطريقة احترافية. 


وياتى السؤال هنا .

هل تحتاج كتابة الاكواد الى تسجيل الدخول إلى Office 365 | Microsoft Office  
بالطبع لا فعند تحميلك ميكروسوفت اوفيس 2007 او 2010 او 2016 او 2019 مجانا من خلال موقعنا من هنا
فانت الان لديك برنامج الاكسل وتقوم بفتح نافذة الاكواد وكتابة جميع التعليمات البرمجية على حاسوبك بطريقة سهلة جدا

الكود المستخدم فى الشرح

sub emad()
Application.ScreenUpdating = False
Dim wsh As Worksheet, xx As Integer, lr As Integer
 For Each ws In ThisWorkbook.Worksheets
   xx = Sheet2.Cells(21, 2).End(xlUp).Row
    Sheet2.Activate
     For r = 8 To xx
      If Cells(r, 2).Value = wsh.Name Then
       If Cells(r, 2).Value <> Empty Then
        Range(Cells(r, 3), Cells(r, 5)).Copy
    ws.Activate
     lr = wsh.Cells(Rows.Count, 1).End(xlUp).Row + 1
      wsh.Range("a" & lr).Value = Date
      wsh.Range("b" & lr).PasteSpecial (xlPasteValues)
    End If
    End If
Next
Next
  Application.CutCopyMode = False
  Sheet2.Activate
  Sheet2.Range("b8:e21").ClearContents
  Application.ScreenUpdating = True
     
     
End Sub


وبهذ انكون قد انتهينا من كتابة هذا الكود 
اذا عجبك المقال ادعمنا بمشاركتة على وسائل التواصل الاجتماعى 

لتحميل ملف العمل من هنا





الاسمبريد إلكترونيرسالة