سمرقند الجيلاني قام بنشر يونيو 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 شكرا اخي الكريم
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.