محتاج تصحيح الكود

[2saad]

اخواني اعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

محتاج اصحح الكود بالملف المرفق

ولكم جزيل الشكرW_S.xlsm

[محمد هشام.]

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

تفضل استاد سغد 

Sub Test()
    Dim lr As Long
    Application.ScreenUpdating = False
    With Sheet1

        lr = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

        .Range(.Cells(10, "D"), .Cells(lr, "F")).Copy Sheet2.Cells(10, "D")
        .Range(.Cells(10, "I"), .Cells(lr, "I")).Copy Sheet2.Cells(10, "L")
        .Range(.Cells(10, "L"), .Cells(lr, "L")).Copy Sheet2.Cells(10, "N")

    End With
    Application.ScreenUpdating = True
    
End Sub

 

 

W_S.xlsm

تم تعديل ديسمبر 16, 2022 بواسطه Mohamed Hicham

[2saad]

شكرا جزيلا علي الكود

ولي طلب عند حضرتك 

عايز افهم الكود لآني حاولت افهمه مش عارف

لأني عايز اطبقه في الشغل

[محمد هشام.]

تم تعديل الملف بداخله شرح مبسط @2saad

[2saad]

اين الملف يا اخي

 

[محمد هشام.]

تم التعديل في الملف المرفق في المشاركة رقم 1

واليك كود اخر يمكنك التعديل عليه ليتوافق مع ملفك الاصلي 

Sub copy_columns_paste()
Dim lr As Integer, MH As Integer, sh1 As Worksheet, sh2 As Worksheet, i As Long

Sheet2.Activate
'افراغ البيانات القديمة
  Range("d10", Range("F" & Rows.Count).End(4)).ClearContents
  Range("L10", Range("L" & Rows.Count).End(4)).ClearContents
  Range("N10", Range("N" & Rows.Count).End(4)).ClearContents
Set sh1 = Sheet1
Set sh2 = Sheet2
lr = sh1.Cells(Rows.Count, 4).End(xlUp).Row
   For i = 10 To lr ' تحديد صف بداية النسخ
     MH = sh2.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
      
'العمود المراد ترحيله من شيت 1 _____ العمود المرحل اليه في شيت 2
      sh2.Cells(MH, 4) = sh1.Cells(i, 4)
       sh2.Cells(MH, 5) = sh1.Cells(i, 5)
         sh2.Cells(MH, 6) = sh1.Cells(i, 6)
          sh2.Cells(MH, 12) = sh1.Cells(i, 9)
           sh2.Cells(MH, 14) = sh1.Cells(i, 12)
         
        Next i
End Sub

 

تم تعديل ديسمبر 16, 2022 بواسطه Mohamed Hicham

[2saad]

الله ينور علي حضرتك ومشكور جزيلا

ومعلش أنا بتعبك معاي

انا عايز في الكود الأول يرحل البيانات بدون تنسيق