ehabaf2 قام بنشر فبراير 12 مشاركة قام بنشر فبراير 12 السلام السادة الافاضل خبراء الموقع المحترم اوفيسنا ارجو كود ترحيل بيانات من اعمدة محددة بناء على شرط فى اكثر من عمود مرفق الملف المطلوب العمل عليه الف الف شكرا لحضراتكم ملف عمليات.xlsx رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 12 مشاركة قام بنشر فبراير 12 محتاج شرح بسيط تفصيلي الكود يقوم بترحيل الملون بالاصفر إلى اين رابط هذا التعليق شارك More sharing options...
ehabaf2 قام بنشر فبراير 13 الكاتب مشاركة قام بنشر فبراير 13 يرحل الى sheet2 يرحل كل البيانات التى ينطبق عليها الشرط بنفس ترتيب الاعمدة الموجود فى sheet 2 الف الف شكر لمرور حضرتك رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 13 مشاركة قام بنشر فبراير 13 3 ساعات مضت, ehabaf2 said: يرحل الى sheet2 يرحل كل البيانات التى ينطبق عليها الشرط بنفس ترتيب الاعمدة الموجود فى sheet 2 الف الف شكر لمرور حضرتك ماهو الشرط اخى الكريم رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر فبراير 14 أفضل إجابة مشاركة قام بنشر فبراير 14 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته جرب الحلول التالية ربما هدا ما تقصده Sub test1() Dim crit$, crit2$, F() As String Dim rng As Range, lr As Long Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("Sheet2") ReDim F(1 To 4) 'Bill Type Code ******************************************Action Type & Terminal Type F(1) = "240": F(2) = "2400": F(3) = "26408": F(4) = "293": crit = "DEB": crit2 = "INT" Application.ScreenUpdating = False If WS.AutoFilterMode Then WS.AutoFilterMode = False With WS.Range("A2:K2") .AutoFilter 3, F, xlFilterValues: .AutoFilter 4, crit, xlFilterValues: .AutoFilter 11, crit2, xlFilterValues lr = WS.Columns("A:A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set rng = WS.Range("A3:K" & lr).SpecialCells(xlCellTypeVisible) If rng.Cells.Count > 1 Then desWS.Range("A2:F" & Rows.Count).Clear With rng Cpt = Split("A,B,D,J,G,K", ",") ' الاعمدة المرحلة Col = Split("A,B,C,D,E,F", ",") 'الاعمدة المرحل اليها For i = LBound(Cpt) To UBound(Cpt) WS.Range(Cpt(i) & "2:" & Cpt(i) & lr).Copy desWS.Range(Col(i) & "1") Next i End With End If .AutoFilter Application.ScreenUpdating = True End With End Sub ''''''''''''''''''''''''''''''''''''''' Sub test2() Dim a, i&, k&, F$, S$: F = "DEB": S = "INT" Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("Sheet2") Application.ScreenUpdating = False desWS.Range("A2:F" & Rows.Count).Clear a = WS.Range("A2:K" & WS.[A65000].End(xlUp).Row) For i = 1 To UBound(a) 'Action Type & Terminal Type If a(i, 4) = F And a(i, 11) = S Then ''Bill Type Code If a(i, 3) = "240" Or a(i, 3) = "2400" Or a(i, 3) = "26408" Or a(i, 3) = "293" Then ' الاعمدة المرحلة desWS.Cells(k + 2, 1).Resize(, 6) = Application.IfError(Application.Index(a, i, Array(1, 2, 4, 10, 7, 11)), "") k = k + 1 End If End If Next Application.ScreenUpdating = True End Sub ملف عمليات V1.xlsm تم تعديل فبراير 14 بواسطه محمد هشام. Modify column names 4 رابط هذا التعليق شارك More sharing options...
ehabaf2 قام بنشر فبراير 14 الكاتب مشاركة قام بنشر فبراير 14 السلام عليكم السادة اعضاء الجروب الافاضل استاذنا الغالى محمد هشام الف الف شكر لحضرتك و لتعبك الكود يعمل و ينفذ المطلوب بمنتهى الاحترافيه زادك الله من فضله و علمه و بارك الله فيك و فى اسرتك الكريمة رابط هذا التعليق شارك 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.