مساعده فى ترحيل بيانات من شيت لاخر

[fatma ali]

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

 

اريد ترحيل بيانات خليه معينه من شيت لاخر عن الضغط  على زر بناء على كود العميل 

 

الشرح مفصل فى الملف المرفق

 

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

 

book.rar

[أبو حنــــين]

السلام عليكم

استعمل هذا الكود

Private Sub CommandButton2_Click()

Dim LastRow As Long, i As Long, ii As Byte
With Sheets("العملاء")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp)
        For i = 2 To LastRow
                If .Cells(i, 1) = Range("e2") Then
                           For ii = 3 To 9
                      If IsEmpty(.Cells(i, ii)) Then
                 .Cells(i, ii) = Range("e16").Value
              Exit For
          End If
       Next
    End If
Next
End With

End Sub

book.rar

[fatma ali]

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

 

شكرا لحضرتك على المساعده 

 

ولكن عند تطبيق الكود على الملف الاصلى فانه يظهر خطأ ولكنه يقوم بتنفيذ المطلوب

 

 مع العلم اننى لم اغير الا ارقام بعض لخلايا فقط

 

Error 1004 Application defined or object defined error 

Dim LastRow As Long, i As Long, ii As Byte
With Sheets("الأعضاء")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp)
        For i = 2 To LastRow
        'الخطأ فى هذا السطر'
                If .Cells(i, 1) = Range("d4") Then
                           For ii = 3 To 9
                      If IsEmpty(.Cells(i, ii)) Then
                 .Cells(i, ii) = Range("h41").Value
              Exit For
          End If
       Next
    End If
Next
End With

حتى اننى قمت باضافه اسم الشيت للخلايا الموجوده فى شيت الفاتورة

Dim LastRow As Long, i As Long, ii As Byte
With Sheets("الأعضاء")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp)
        For i = 2 To LastRow
        'الخطأ فى هذا السطر'
                If .Cells(i, 1) = Sheets("الفاتورة").Range("d4") Then
                           For ii = 3 To 9
                      If IsEmpty(.Cells(i, ii)) Then
                 .Cells(i, ii) = Sheets("الفاتورة").Range("h41").Value
              Exit For
          End If
       Next
    End If
Next
End With

ولكن يظهر نفس الخطأ 

 

ارجو الافاده ،،،

تم تعديل أكتوبر 23, 2013 بواسطه fatma ali

[أبو حنــــين]

السلام عليكم

اذا كان الكود يقوم بعملة

أكتب في بداية الكود السطر التالي

On Error Resume Next

[fatma ali]

انا فعلا كنت عملت كده قبل ما ابعت لحضرتك بس لما اجى اضغط على الزرار او اعمل رن البرنامج بيهنج ،،،،

[الـعيدروس]

السلام عليكم

 

جرب هذا الكود

Public Sub Ali_Trn()
With Sheet2
Dim Rng As Range, Lon As Range
If [E2] = "" Then GoTo 1
Set Rng = .Range("A:A")
  Set Lon = Rng.Find(What:=[E2].Text, LookIn:=xlValues, LookAt:=xlPart)
  If Not Lon Is Nothing Then
  Set Rn = Lon.Resize(, 8)
    Ls = Rn.Cells(1, Rn.Columns.Count).End(xlToLeft).Column
    Lon.Offset(, Ls) = [E16]
  End If
End With
1 End Sub

[fatma ali]

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

 

اولا شكرا للعضو أبو حنين والعضو الـعيدروس على الاهتملم والمساعده

 

ثانيا لقد توصلت للحل بتغيير بسيط فى الكود

 

هذا هو الكود للافاده

Application.ScreenUpdating = False
Dim i As Long, ii As Byte
With Sheets("العملاء")
LR = [A9999].End(xlUp).Row
For i = 2 To LR
  If .Cells(i, 1) = Range("d4") Then
   For ii = 3 To 8
   If IsEmpty(.Cells(i, ii)) Then
   .Cells(i, ii) = Range("h52").Value
   
            Exit For
          End If
       Next
    End If
Next
End With

تم تعديل أكتوبر 24, 2013 بواسطه fatma ali