ارفق الكود بعد التعديل من قيل اخواني الكرام ولكن بقيت المشكلة قد يكون السبب قلة دقتي في التعديل المطروح من قبل الاخوان الافاضل لذا سارفق الكود والملف لكي يتسنى لكم مساعدتي لطفا الرقم السري للملف tareq972708 Private Sub CommandButton1_Click() On Error Resume Next Dim i As Integer, LastR As Long, ws, ws1 As Worksheet Set ws = ThisWorkbook.Sheets("البيانات") Set ws1 = ThisWorkbook.Sheets("المدراء") LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 LastRow1 = ws1.Cells(Rows.Count, "B"