محتاج تعديل بسيط فى كود ترحيل

[ehabaf2]

السلام عليكم الاخوة الافاضل عندى كود ترحيل بيرحل كل الصفوف و لكن انا محتاج تعديل الكود لكى يرحل الصفوف من B    الى K  بشرط وجود قيمة فى العمود   G أو   H

يرحل فقط الصف اللى فيه قيمة فى العمود   G أو   H

مرفق ملف

كود ترحيل.xlsm

[محمد هشام.]

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

بطريقة مختلفة 

Sub CopyRow_Item()
Dim i&, j&, n&, cnt&, r&, lr&, a As Boolean
Dim arr() As Variant, rCrit As Variant, rng As Variant
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("قاعدة العملاء")
cnt = 2
With WS
 If [N1] = Empty Then MsgBox "اصحى و اكتب التاريخ", vbExclamation: Exit Sub
  Application.ScreenUpdating = False
            lr = .Columns("b:k").Find(What:="*", _
             SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    a = True
       n = 0
        rng = .Range("B2:K" & .Range("B" & Rows.Count).End(xlUp).Row).Value
        cnt = .Cells(.Rows.Count, "AM").End(xlUp).Row
        ReDim arr(1 To UBound(rng), 1 To UBound(rng, 2))
        For i = 1 To UBound(rng)
            If rng(i, 6) <> "" Or rng(i, 7) <> "" Then
              a = False
                n = n + 1
                For j = 1 To UBound(rng, 2)
                    arr(n, j) = rng(i, j)
                Next j
            End If
        Next i
 If n > 0 Then
    .Range("AM" & cnt + 1).Resize(n, UBound(arr, 2)) = arr
    cnt = cnt + n
 For r = 2 To lr
    Union(.Range("F" & r).Resize(, 2), .Range("I" & r)).ClearContents
    Next r
     Application.Goto .Range("AM" & 2), True: [N1] = ""
    End If
End With
  Application.ScreenUpdating = True
  
If a Then
  MsgBox "الرجاء إظافـــة التحصيلات", vbExclamation
 Else
    MsgBox "الحمد لله - تم ترحيل التحصيلات بنجاح " & vbNewLine & _
                             "            مستر إيهاب الاسوانى", 64
   End If
End Sub

 

 

كود ترحيل V3.xlsm

تم تعديل يوليو 4, 2024 بواسطه محمد هشام.

[ehabaf2]

الاستاذ الفاضل محمد هشام.

الف الف شكر لحضرتك الكود يعمل بكفاءة عالة و سرعة و حضرتك زود اضافة جميلة للكود

زادك الله من علمه و فضله

ربنا يحفظك و يعزك استاذنا الفاضل

[ehabaf2]

الاستاذ الفاضل محمد هشام.

عزرا عند الترحيل كل مرة بيمسح الترحيل القديم و يكتب الترحيل الجديد مكانه و لكن كنت محتاج الترحيل يكون تحت بعضه يرحل اول مرة و تحتها يرحل المرة الثانية و تحتها يرحل المرة الثالثة و هكذا

اكرر شكرى لحضرتك

[محمد هشام.]

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

 

تم تعديل يوليو 4, 2024 بواسطه محمد هشام.

[ehabaf2]

الاستاذ الفاضل محمد هشام.

الف الف شكر لاهتمام حضرتك

الكود يعمل و ينفذ المطلوب

اكرر شكري لحضرتك