kinguter1 قام بنشر يونيو 7, 2016 مشاركة قام بنشر يونيو 7, 2016 (معدل) الأساتذة الأفاضل خبراء اكسيل برجاء مساعدتنا فى فى إضافة السطر الموجود لأنى عند تشغيله يوقف عمل النسخ ولكم جزيل الشكر Sub Tarheel() Application.ScreenUpdating = False prompt = "åá ÊÑíÏ ÊÍÏíË ÏÑÌÇÊ ÃÚãÇá ÇáÓäÉ" Command_buttons = vbYesNo + VbMsgBoxRt1Reading Title = "ÊÝÑíÛ æØÈÇÚÉ ÇáÏÑÌÇÊ" project = MsgBox(prompt, Command_buttons, Title) If project = vbYes Then PT = ActiveWorkbook.Path Application.DisplayAlerts = False For SH = 20 To 24 nm = Format(SH, "@") Sheets(nm).Activate LR = [A9999].End(xlUp).Row Range("aa6:ca3930").Copy Workbooks.Open Filename:=PT & "\" & nm & ".xlsm"'Sheets("maindata").Range("aa1:bc2000").UnMerge Sheets("maindata").Range("aa1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Sheets("maindata").Range("aa1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False ActiveWorkbook.Close (True) Next Application.CutCopyMode = False Application.DisplayAlerts = True Sheets("main").Select MsgBox "Êã ÊÍÏíË ÏÑÌÇÊ ÃÚãÇá ÇáÓäÉ ÈäÌÇÍ" Else End If Application.ScreenUpdating = True End Sub تم تعديل يونيو 7, 2016 بواسطه kinguter1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.