اذهب الي المحتوي
أوفيسنا

كود ترحيل البيانات

husain alhammadi

بواسطه husain alhammadi
في منتدى الاكسيل Excel

 مشاركة

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

husain alhammadi

husain alhammadi

قام بنشر
قام بنشر

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

ارجوا مساعدتي في تعديل الكود التالي  

Private Sub CommandButton1_Click()

    ' إيقاف تحديث الشاشة لتسريع العملية
    Application.ScreenUpdating = False

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim NextRow As Long

    ' تحديد ورقة العمل المصدر (Sheet1) وورقة العمل الهدف (Sheet2)
    Set wsSource = Worksheets("Sheet1")
    Set wsTarget = Worksheets("Sheet2")

    ' 1. البحث عن الصف الفارغ التالي في العمود A
    NextRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    ' 2. ضمان أن يبدأ ترحيل البيانات من الصف رقم 3 على الأقل
    If NextRow < 3 Then NextRow = 3
    
    ' -------------------------------------------------------------
    ' نقل البيانات إلى الصف الجديد (NextRow) في Sheet2
    ' -------------------------------------------------------------
    
    ' الأعمدة A إلى F
    wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
    wsTarget.Cells(NextRow, "B").Value = wsSource.Range("D5").Value
    wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D6").Value
    wsTarget.Cells(NextRow, "D").Value = wsSource.Range("H4").Value
    wsTarget.Cells(NextRow, "E").Value = wsSource.Range("H5").Value
    wsTarget.Cells(NextRow, "F").Value = wsSource.Range("H6").Value
    
    ' الأعمدة G, H, I (القيم الأخيرة هي التي تُحفظ)
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E11").Value
    wsTarget.Cells(NextRow, "H").Value = wsSource.Range("G11").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("C12").Value
    
    wsTarget.Cells(NextRow, "H").Value = wsSource.Range("E12").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G12").Value
    
    wsTarget.Cells(NextRow, "H").Value = wsSource.Range("E13").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G13").Value
    
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E14").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G14").Value
    
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E15").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G15").Value
    
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E16").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G16").Value
    
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E17").Value
    wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G17").Value
    
    ' الأعمدة J و L (القيم الأخيرة هي التي تُحفظ)
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C21").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G21").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C22").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G22").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C23").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G23").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C24").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G24").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C25").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G25").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C26").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G26").Value
    
    wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C27").Value
    wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G27").Value
    
    ' الأعمدة M و N (القيم الأخيرة هي التي تُحفظ)
    wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C31").Value
    wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H31").Value
    
    wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C32").Value
    wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H32").Value
    
    wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C33").Value
    wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H33").Value
    
    wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C34").Value
    wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H34").Value
    
    ' الأعمدة O, C, P, Q (القيم الأخيرة هي التي تُحفظ)
    wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B38").Value
    wsTarget.Cells(NextRow, "C").Value = wsSource.Range("B39").Value
    
    wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B40").Value
    wsTarget.Cells(NextRow, "C").Value = wsSource.Range("B41").Value
    
    wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B42").Value
    
    wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B47").Value
    wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B48").Value
    
    wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B49").Value
    wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H49").Value
    
    wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H50").Value
    wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H51").Value
    
    ' الأعمدة R, S, T, U
    wsTarget.Cells(NextRow, "R").Value = wsSource.Range("C57").Value
    wsTarget.Cells(NextRow, "S").Value = wsSource.Range("C58").Value
    wsTarget.Cells(NextRow, "T").Value = wsSource.Range("C59").Value
    wsTarget.Cells(NextRow, "U").Value = wsSource.Range("B59").Value
    
    ' إعادة تشغيل تحديث الشاشة
    Application.ScreenUpdating = True
    
    MsgBox "تم ترحيل البيانات بنجاح إلى ورقة العمل 'Sheet2' في الصف رقم " & NextRow & ".", vbInformation
End Sub

 

محضر الاجتماع.xlsm

Foksh

Foksh

قام بنشر
قام بنشر
22 دقائق مضت, husain alhammadi said:

ارجوا مساعدتي في تعديل الكود التالي  

 

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

الأصل أخي الكريم أن توضح نوع المشكلة التي تواجهها ..

ما التعديل الذي تريده !!!

ما المشكلة التي تواجهك ؟؟؟

 

شكراً لسعة صدرك :wub: ، متمنياً منك التوضيح والإفصاح بشكل أوضح عن المطلوب .

husain alhammadi

husain alhammadi

قام بنشر
  • الكاتب
قام بنشر 
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim NextRow As Long
    Dim i As Long
    Dim StartRow As Long
    Set wsSource = Worksheets("Sheet1")
    Set wsTarget = Worksheets("Sheet2")
    StartRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
    NextRow = StartRow
    If NextRow < 3 Then NextRow = 3
    For i = 0 To 5
        wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
        wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
        wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
        wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
        wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
        wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
        wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
        wsTarget.Cells(NextRow, "H").Value = wsSource.Range("C" & (11 + i)).Value
        wsTarget.Cells(NextRow, "I").Value = wsSource.Range("E" & (11 + i)).Value
        If i < 5 Then
            wsTarget.Cells(NextRow, "J").Value = wsSource.Range("G" & (11 + i)).Value
        Else
            wsTarget.Cells(NextRow, "J").Value = wsSource.Range("G17").Value
        End If
        NextRow = NextRow + 1
    Next i
    For i = 0 To 6
        wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
        wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
        wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
        wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
        wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
        wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
        wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
        wsTarget.Cells(NextRow, "K").Value = wsSource.Range("C" & (21 + i)).Value
        wsTarget.Cells(NextRow, "L").Value = wsSource.Range("E" & (21 + i)).Value
        wsTarget.Cells(NextRow, "M").Value = wsSource.Range("G" & (21 + i)).Value
        NextRow = NextRow + 1
    Next i
    For i = 0 To 3
        wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
        wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
        wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
        wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
        wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
        wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
        wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
        wsTarget.Cells(NextRow, "N").Value = wsSource.Range("C" & (31 + i)).Value
        wsTarget.Cells(NextRow, "O").Value = wsSource.Range("G" & (31 + i)).Value
        NextRow = NextRow + 1
    Next i
    For i = 0 To 6
        wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
        wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
        wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
        wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
        wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
        wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
        wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
        wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B" & (37 + i)).Value
        NextRow = NextRow + 1
    Next i
    For i = 0 To 4
        wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
        wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
        wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
        wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
        wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
        wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
        wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
        wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("B" & (47 + i)).Value
        wsTarget.Cells(NextRow, "R").Value = wsSource.Range("G" & (47 + i)).Value
        NextRow = NextRow + 1
    Next
    wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value
    wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value
    wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value
    wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value
    wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value
    wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value
    wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value
    wsTarget.Cells(NextRow, "S").Value = wsSource.Range("C54").Value
    wsTarget.Cells(NextRow, "T").Value = wsSource.Range("C57").Value
    wsTarget.Cells(NextRow, "U").Value = wsSource.Range("C58").Value
    wsTarget.Cells(NextRow, "V").Value = wsSource.Range("C59").Value
    wsTarget.Cells(NextRow, "W").Value = wsSource.Range("B61").Value
    Application.ScreenUpdating = True
    MsgBox "تم ترحيل البيانات بنجاح إلى " & (NextRow) & " صفوف.", vbInformation
End Sub

السلام عليكم و رحمة الله و بركاتة ارفق لكم المرفق بعد التعديل و لا يزال  لايتم الترحيل و في الملف يوجد رقم سري 123 و لكم مني جزيل الشكر

 

محضر الاجتماع.xlsm

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

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

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

Important Information

  I accept