ضبط كود الترحيل من الفاتورة الى الصفحات الأخرى بدون فراغات

Sub Transfer()

Dim fa, mb, mo As Worksheet

Dim lr1, lr2 As Integer

Set fa = Sheets("الفاتورة")

Set mb = Sheets("مبيعات")

Set mo = Sheets("مشتريات")

If [I4].Value = "" Or [C3].Value = "" Or [d2].Value = "" Or [H3].Value = "" Then

MsgBox "ÈíÇäÇÊ ÇáÝÇÊæÑÉ ÛíÑ ãßÊãáÉ", vbCritical, "ÊäÈíÜÜå":

Else

Dim x As String

x = [d2].Value

fa.Activate

lr1 = fa.Range("B" & Rows.Count).End(xlUp).Row

Range("B6:L" & lr1).Copy

Sheets(x).Activate

lr2 = Range("B" & Rows.Count).End(xlUp).Row

Range("B" & lr2 + 1).Select

Selection.PasteSpecial xlPasteValues

fa.Activate

[d2].Select

Range("C6:E20").ClearContents

Range("G6:G20").ClearContents

Range("I6:I20").ClearContents

Range("D2:G2").ClearContents

Range("H3:J3").ClearContents

[C3].ClearContents

MsgBox ("تم ترحيل البيانات بنجاح ")

End If

End Sub