ترحيل بدون فرغات

[عمر الجزاوى]

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

ترحيل بدون فرغات.xlsm

[lionheart]

Sub pastespc()
    Dim t As Long, r As Long, m As Long
    lr = Range("d" & Rows.Count).End(3).Row + 5
    t = lr
    Range("a1:e34").Copy Range("a" & lr)
    m = Range("d" & Rows.Count).End(3).Row
    For r = m To t + 5 Step -1
        If Application.CountA(Range("A" & r).Resize(1, 4)) = 0 Then
        Range("A" & r).Resize(1, 5).Delete
        End If
    Next r
    If Cells(8, 2) <> "" Then
        lrr2 = Range("h" & Rows.Count).End(xlUp).Row + 1
    Else
        lrr2 = Range("h" & Rows.Count).End(xlUp).Row + 1
        ActiveSheet.Hyperlinks.Add anchor:=Cells(lrr2, 8), Address:="", SubAddress:="ÝÇÊæÑÉ!" & "e" & lr + 2
    End If
    Cells(lrr2, 8) = [e3]
    Cells(lrr2, 9) = [c5]
    Cells(lrr2, 10) = [b7]
    Cells(lrr2, 11) = [e32]
    [e3] = [e3] + 1
End Sub

 

[عمر الجزاوى]

استاذ قلب الاسد اعمالكم دائما جميله بجمال روحكم وفيها ابداع وكرم بكرم وطيب شخصكم تحياتى لكم 

[عمر الجزاوى]

السلام عليكم ورحمة الله وبركاته استاذ قلب اسد معذرة حدث تعديل بسيط فى الملف فى حدث الشيت كود عند الكتابة فى العمود A  يدرج صف المطلوب دمج عند ادراج صف يدمج صف عمود البيان من العمود B  الى E يدمج الصف ويقوم بترحيل الفاتورة الى اسفل 

ترحيل بدون فرغات.xlsm

تم تعديل أكتوبر 8, 2021 بواسطه عمر الجزاوى

[lionheart]

Target(2, 1).Resize(1, 8).Interior.Color = &HFF00&
Target(2, 1).Offset(, 1).Resize(1, 4).Merge

 

[عمر الجزاوى]

كدا تمام اتفضل اخر جزء وهو ارحل الفاتورة الى اسفل

[lionheart]

Not clear for me

[عمر الجزاوى]

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