من فضلكم ارجو المساعدة ترحيل خلايا محددة + فورم بحث

[يوسف شرف]

السلام عليكم و رحمة الله تعالى و بركاته  

ارجو من خبراء المنتدى  في ملف اكسل لترحيل الاعمدة التي  تحتوي في صف remarks على كلمة" rep" إلى صفحة repair ... ( ترحيل كل قيم العمود الرقم التسمية السماكة ...) و انجاز فورم بحث  في صفحة repair  ( البحث يكون اما عن ادخال رقم التقرير او قطر الحام أو تاريخ التقرير او  اي من المتغيرات الاخرى  )  

 و لكم مني جزير الشكر مقدما 

 

 

 

NDT Reporting.rar

[الـعيدروس]

السلام عليكم

 

كود الترحيل

Public Sub Tr()
Dim r, ri, rr, Inb$
Dim Chk, Nm, Ck, ii%
Inb = InputBox("إدخل شرط الترحيل", , "rep")
If Inb = vbNullString Or Inb = Cancel Then Exit Sub
With Feuil5
On Error Resume Next
 Ck = Feuil6.Cells(Rows.Count, 2).End(xlUp).Offset(0, 18)
 Chk = IsNumeric(Ck)
 Nm = IIf(Chk, Val(Ck) + 1, 1)
On Error GoTo 0
r = 11: ri = 30
For rr = r To ri
  If .Cells(rr, 8) = Inb Then
   ii = ii + 1
   With Feuil6.Cells(Rows.Count, 2).End(xlUp)
     For ic = 2 To 19
       .Offset(1, ic - 2) = Feuil5.Cells(rr, ic)
       .Offset(1, 18).Value = Nm
     Next
   End With
  End If
Next rr
If ii Then MsgBox "تم الترحيل بنجاح", vbInformation, ""
End With
End Sub

[يوسف شرف]

أخي العيدروس  شكرا جزيلا  و جزاك الله كل خير . 

اخي الكريم  جربت الكود الخاص بترحيل الخلايا و هو اكثر من رائع  . و يشتغل 100% 

بس المشكلة أنو رقم الربورت مش  مثلا مش لازم يكون اول ربورت هو  رقم 1 و اللي يليه هو رقم 2   فرقم الربورت هو الرقم اللي بالخلية m4.

 ويا ريت تتكرم و توضحلي كيفية اضافة  فورم بحث و تعديل   في'  feuil6 'repair    بحيث يعطيني نتائج البحث  عن طريق ادخال رقم الربورت او رقم اللحام  او أي من القيم الموجودة في صفوف الجدول 

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

 

كل الود و الاحترام

[الـعيدروس]

تفضل

اخذ رقم التقرير من "M4"

وفورم البحث ان وجد وقت

سوف اعمل عليه

Public Sub Tr()
Dim r, ri, rr, Inb$
Dim Chk, Nm, Ck, ii%
Inb = InputBox("إدخل شرط الترحيل", , "rep")
If Inb = vbNullString Or Inb = Cancel Then Exit Sub
With Feuil5
On Error Resume Next
Nm = [M4]
r = 11: ri = 30
For rr = r To ri
  If .Cells(rr, 8) = Inb Then
   ii = ii + 1
   With Feuil6.Cells(Rows.Count, 2).End(xlUp)
     For ic = 2 To 19
       .Offset(1, ic - 2) = Feuil5.Cells(rr, ic)
       .Offset(1, 18).Value = Nm
     Next
   End With
  End If
Next rr
On Error GoTo 0
If ii Then MsgBox "تم الترحيل بنجاح", vbInformation, ""
End With
End Sub

[يوسف شرف]

بارك الله فيك مشكووووووووووووووووور  جدا 

 في انتظار ردكم تقبل مني فائق عبارات التقدير و الاحترام 

[الـعيدروس]

السلام عليكم

 

شاهد المرفق

 

NDT Reporting_A.rar

[يوسف شرف]

شكرا شكرا جزيلا و بارك الله فيك و جعل الله هدا العمل في ميزان حسناتك انشاء الله .

يوسف شرفة 

 

 

اللهم صل على  محمد عدد معلوماتك و مداد كلماتك كلما دكرك و دكره الداكرون و غفل عن دكرك و دكره الداكرون