السلام عليكم استاذنا الكبير ياسر --بالتأكيد بعد اذن حضرتك
تم التعديل على المديول رقم 2 ليصبح بهذا الشكل
CODE
Sub Macro1()
Dim Arr
With Sheets("Sheet1")
Arr = Array(.Range("g2"), .Range("C1"), .Range("E1"), .Range("E3"), .Range("C3"), .Range("H21"), .Range("H22"), .Range("H23"))
End With
With Sheets("íæãíå ÇáãÈíÚÇÊ")
.Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1).Resize(1, UBound(Arr) + 1).Value = Arr
End With
MsgBox "Done...", 64
Range("C6").Select
ActiveWindow.SmallScroll Down:=-3
Range("g2").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(1)
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = "Sheet1 (2)"
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = Range("g2").Value
Range("B11").Select
ActiveWindow.SmallScroll Down:=-3
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=0
Range("c5:f20").Select
Selection.ClearContents
Range("C3").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-18
Range("g2").Select
Selection.Copy
Range("I9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C3").Select
End Sub
وقد تم عمل كل المطلوب ومنها تم عمل كشف حساب العميل بمعادلات المصفوفة
وهذا هو الملف بعد التعديل
gedyana.rar