ابو اسامة العينبوسي

حاضر Application.Calculation = xlCalculationManual For i = 8 To 12 Cells(i, "F") = Cells(i, "E") Next i Application.Calculation = xlCalculationAutomatic test1-2.rar

السلام عليكم ممكن هكذا ؟ Application.Calculation = xlCalculationManual For i = 8 To 12 Cells(i, 1).End(xlToRight).Offset(0, 1) = Cells(i, "E") Next i Application.Calculation = xlCalculationAutomatic test1-1.rar

السلام عليكم هكذا Sub ÓåãááãÓÝá1_äÞÑ() Dim Z, LR As Long '--------------------------------------------- Range(Cells(12, "M"), Cells(51, "M")).ClearContents '--------------------------------------------- Z = 4 For X = 1 To 3 For i = 1 To Application.WorksheetFunction.CountA(Range(Cells(12, Z).Address, Cells(51, Z).Address)) LR = Cells(100, "M").End(xlUp).Row + 1 Cells(LR, "m") = Cells(i + 11, Z + 1) Next i Z = Z + 3 Next X End Sub اضغظ السهم فوق كلمة تجميع test10.rar

السلام عليكم ممكن بهذا الكود المختصر اخي عبد الله Sub Abu_Ahmed() Range("b15:b114").ClearContents For i = 6 To 14 For x = 1 To Cells(5, i).Value Cells(Range("b10000").End(xlUp).Row + 1, 2) = Cells(4, i) Next x Next i End Sub

السلام عليكم ممكن اشارك اخى عبد الله بهذا الحل السريع لضيق الوقت ان كان المطلوب نكمل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 4 Then Exit Sub Cells(Target.Row, Target.Cells.Offset(0, Target.Value).Column).Value = Target.Cells.Offset(0, -1).Value End Sub TEST 3.rar

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

السلام عليكم مثال طبقه على ملفك مع مراعاة فرق عدد الاعمدة Sub tr() Dim x As Integer For i = 2 To Sheets(1).Cells(100, 1).End(xlUp).Row With Worksheets((Sheets(1).Cells(i, 4).Value)) x = .Cells(100, 2).End(xlUp).Row + 1 .Cells(x, 1) = Sheets(1).Cells(i, 1) .Cells(x, 2) = Sheets(1).Cells(i, 2) .Cells(x, 3) = Sheets(1).Cells(i, 3) End With Next i End Sub test1.rar

السلام عليكم Add this code to the botton in the main sheet Worksheets((Sheets(1).Range("t3").Value)).PrintOut

مشتاق للجميع و الله لكن للضرورة احكام ربيع عربي لكل الاخوة الاحباب

السلام عليكم الاخوة الاحباب

السلام عليكم سلامى لكل الاخوة الاعزاء جرب هذا try this.rar

slamu alikum by this code Brother ActiveWorkbook.Worksheets("letter").PrintOut

السلام عليكم اخى الكريم هذا الكود يظهر الطابعات المثبته لديك بشكل سريع Application.Dialogs(xlDialogPrinterSetup).Show اعدك بحل قريب شامل

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

السلام عليكم Worksheets.Add After:=Worksheets(Worksheets.Count)

السلام عليكم اخى خالد القدس بارك الله فيك ممكن تكون الصيغ التى ادرجها الاخ الخالدى عباره عن صفيف تحتاج ctrl + Shift + enter و الله اعلم الاخ خالدي سيفيدنا اكيد

السلام عليكم =IF(OFFSET(A1,(COUNTA(A:A)),1)="acc",OFFSET(A1,(COUNTA(A:A))-1,0),OFFSET(A1,(COUNTA(A:A)),0)) شكرا لك اخ خالدى لو تطمنا عن الاخ يحيى منذ يومين لم اره على المسنجر test it 2.rar

السلام عليكم بطرق عده منها =OFFSET(A1,(COUNTA(A:A)),0) test it.rar

السلام عليكم اخى الكريم رسالة لقد تم الترحيل مسبقا انا وضعتها كى لاترحل مرتين نفس البيانات استخدم الكود التالى بدل الاخير Dim MyRNG As Range Set MyRNG = Selection For A = 1 To MyRNG.Rows.Count D = Workbooks("ãÍá22").Sheets(1).Cells(1000, 1).End(xlUp).Row + 1 For B = 1 To MyRNG.Columns.Count Workbooks("ãÍá22").Sheets(1).Cells(D, B) = MyRNG.Cells(A, B) Next B Next A و الملف يرحل الى الورقه الاولى من ملف المحل22

السلام عليكم هل فتحت المرفقين معا ؟ جربت الملف . شغال اعد الكره اما بالنسبة لفتح الملف ممكن ذلك و الافضل انشاء ملف جديد مطابق لاسم الملف المدرج في الكود

السلام عليكم اكرر ان لم يكن المطلوب بلغنى لا تنسى فتح المرفقين معاً Dim MyRNG As Range Set MyRNG = Selection If MyRNG.Interior.ColorIndex = 6 Then MsgBox "áÞÏ Êã ÊÑÍíá ÇáäØÇÞ" & vbCrLf & MyRNG.Address(0, 0) & vbCrLf & "ãÓÈÞÇð" Exit Sub End If For A = 1 To MyRNG.Rows.Count D = Workbooks("ãÍá22").Sheets(1).Cells(1000, 1).End(xlUp).Row + 1 For B = 1 To MyRNG.Columns.Count Workbooks("ãÍá22").Sheets(1).Cells(D, B) = MyRNG.Cells(A, B) Next B Next A MyRNG.Interior.ColorIndex = 6 محل11.rar

نكمل الحل ان كان المطلوب

السلام عليكم هذا الملف يرحل(كمثال و اعلم انه ليس طلبك تماما) الى الصفحه الثانيه(sheet2) ما تم اختياره من الصفحة الاولى (sheet1) Dim MyRNG As Range Set MyRNG = Selection For A = 1 To MyRNG.Rows.Count For B = 1 To MyRNG.Columns.Count Sheets(2).Cells(A, B) = MyRNG.Cells(A, B) Next B Next A محل11.rar

السلام عليكم ممكن هكذا اذا تباعدت الاسطر =IF(B2>0,COUNTA(B$2:B2),"") دالة لجعل مسلسل الارقام تلقائى5.rar

السلام عليكم لو ترفق اخى ملف انظر الفكرة التالية و انت في اي صف تكون , اختر من القائمه عمود ستلاحظ انك في نفس الصف من العمود الجديد HYPERLINKS.rar