سمرقند الجيلاني قام بنشر يونيو 7, 2016 قام بنشر يونيو 7, 2016 إذا سمحتم حد يترجملي هذا الكود Dim LR As Integer LR = [a10000].End(xlUp).Row Sheets("ÇáäÇÌÍæä").Range("a9:am138").ClearContents Sheets("ÑÇÓÈ").Range("a8:am1000").ClearContents Application.ScreenUpdating = False X = 8: Y = 8 For I = 8 To LR If Cells(I, 39).Value = "äÇÌÍ" And Cells(I, 2) <> " " Then Range("a" & I).Resize(1, 39).Copy Sheets("ÇáäÇÌÍæä").Range("a" & X).PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False X = X + 1 ElseIf Cells(I, 39).Value = " áå 쾄 ËÇä" And Cells(I, 2) <> " " Then Range("a" & I).Resize(1, 39).Copy Sheets("ÑÇÓÈ").Range("a" & Y).PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False Y = Y + 1 End If Next I Application.ScreenUpdating = True End Sub
mennad sofiane قام بنشر نوفمبر 10, 2017 قام بنشر نوفمبر 10, 2017 في ٦/٦/٢٠١٦ at 14:39, سمرقند الجيلاني said: إذا سمحتم حد يترجملي هذا الكود Dim LR As Integer LR = [a10000].End(xlUp).Row Sheets("ÇáäÇÌÍæä").Range("a9:am138").ClearContents Sheets("ÑÇÓÈ").Range("a8:am1000").ClearContents Application.ScreenUpdating = False X = 8: Y = 8 For I = 8 To LR If Cells(I, 39).Value = "äÇÌÍ" And Cells(I, 2) <> " " Then Range("a" & I).Resize(1, 39).Copy Sheets("ÇáäÇÌÍæä").Range("a" & X).PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False X = X + 1 ElseIf Cells(I, 39).Value = " áå 쾄 ËÇä" And Cells(I, 2) <> " " Then Range("a" & I).Resize(1, 39).Copy Sheets("ÑÇÓÈ").Range("a" & Y).PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False Y = Y + 1 End If Next I Application.ScreenUpdating = True End Sub شكرا اخي الكريم
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان