كود ترحيل على اساس اسم الشبت

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم االاخوة الكرام 

تقبل الله منا ومنكم ومن جمبيع المسلمين صالح الاعمال

 

الاخزة الكرام ارجو المساعده فى عمل كود ترحيل على اساس اسم الشبت

1-      ترحيل من شيت 1 الى شيت ( حسب اسم الشيت بدلااله الخلية A3 ) ..اى لو محتوى الخليه A3      Medi. Kha

يبتم الترحيل الى شيت Medi. Kha ولو محتوى الخليه  A3       Medi. Epe   يتم الترحيل الى شيبت Medi. Epe وهكذا

ان يتم الترحيل من شيت 1 الى الشيت المراد الخليه لb6 الى الخلية b6

                                                   الخليه لc6 الى الخلية c6  وهكذا  منتهيا بالخليه g6

2-      عند اتمام الترحيل يتم كتابة تم الترحيل امام كل خليه تم ترحيها فى العمود h  تم الترحيل ولا يتم الترحيل اكثر من مره

3-      ويتم السوال ا ذا ما ارت مسح البيانات فى شيت 1 ..... ا ذا  كان الاجابه نعم يتم مسح a3 بلاضافة الى c3 : c35  و f6 : j35

 

Book1.rar

[۩◊۩ أبو حنين ۩◊۩]

لقد حاولت مستخدما هاالكود الا انه لم يصلح معى ..هلى من مساعدة

Sub transfer()
Dim cl As Range
Application.ScreenUpdating = False
T = Range("A3").Text
On Error Resume Next
For Each cl In Rng
        x = cl.Column
        Range("B6:G35").Copy
        Sheets(T).Cells(5, x).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Exit For
    End If
Next
Application.ScreenUpdating = True
End Sub

[ياسر خليل أبو البراء]

أبو حنين

اسمح لي أن أقول أني لا أفهم طلبك بشكل وااااضح حيث أن التفصيل غير مفصل بشكل تفصيلي يسهل معه الفهم ..

ما فهمت إلا النقطة الأولى أنك تريد الترحيل حسب قيمة الخلية A3 في ورقة العمل المسماة "1" ...لكن الخلايا التي سترحل ما هي الخلايا التي سترحل ؟ أين تريد ترحيلها بالضبط ؟ وهل الترحيل يمسح البيانات السابقة في أوراق العمل المرحل إليها أم أنه يضيف إليها ؟ والنطاقات المراد مسحها غير منطقية .!..؟؟؟

يرجى التوضيح وبأسلوب مبسط يفهمه الجميع

 

نسيت أقولك يا ريت لما تحب تدرج كود يوضع بين أقواس الكود ليظهر بشكل مناااااااااسب

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم 

اخى الحبيب ياسر ارجو ان يتضح المطلوب معى 

اخى الحبيب  الساده الزملاء

الخلايا التى يراد ترحيها من شيت 1 هى

الخلايا التى بها بيانات اعتيارا من الخليه  b6 الى  g35

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

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

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

اولا الخليه A3  هذا بلاضافى الى

B6  الى B35  وكذلك من F6  الى G35

تم تعديل يونيو 4, 2015 بواسطه ۩◊۩ أبو حنين ۩◊۩

[ياسر خليل أبو البراء]

الأخ الكريم أبو حنين

جرب الكود التالي

Sub TransferToSpecificSheet()
    Dim Cell As Range, T As String, LR As Long, LRT As Long
    Dim WS As Worksheet
    
    Set WS = Sheets("1")
    LR = WS.Cells(35, 3).End(xlUp).Row
    T = WS.Range("A3").Value
    
    Application.ScreenUpdating = False
            If Not IsEmpty(T) Then
                Range("B6:G" & LR).Copy
                With Sheets(T)
                    LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1
                    .Cells(LRT, 2).PasteSpecial xlPasteValues
                End With
            End If
            Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

بقيت نقطة المسح فقط ..وأنا لدي بعض الأعمال

إن شاء الله يساعدك أحد الأخوة بها

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

اخى الحبيب ياسر

جزاك الله كل الخير  .. وجعلة الله فى ميزان حسناتك

وتقبل عزرى فى عدم الايضاح من اول مره

سلمت يداك بكل خير

[مختار حسين محمود]

الكود بعد اضافة مسح النطاقات المحددة

Sub TransferToSpecificSheet()
    Dim Cell As Range, T As String, LR As Long, LRT As Long
    Dim WS As Worksheet
    
    Set WS = Sheets("1")
    LR = WS.Cells(35, 3).End(xlUp).Row
    T = WS.Range("A3").Value
    
    Application.ScreenUpdating = False
            If Not IsEmpty(T) Then
                Range("B6:G" & LR).Copy
                With Sheets(T)
                    LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1
                    .Cells(LRT, 2).PasteSpecial xlPasteValues
                End With
            End If
            
            Sheets("1").Range("A3,B6:B35,F6:G35").Select
            Selection.ClearContents
                        
            Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

اخى الكريم مختار 

اخى الكريم ياسر

جزاكم الله كل الخير  .. وجمع اعضاء المنتدى 

سلمت يداك بكل خير

اخى الحبيب .... بوجد تحفظ اخير 

عند تفعيل الكود ولم يكن يحتوى الشيت  شيت(1) على بيانات سوى سوى الخليه A3

يتم ترحيل راس الجدول 

كيف يمكن التغلب على ذلك 

تم تعديل يونيو 5, 2015 بواسطه ۩◊۩ أبو حنين ۩◊۩

[محمد حسن المحمد]

السلام عليكم أخي أبو حنين الكريم:

من خلال نظرتي لملفات الترحيل التي رأيتها سابقاً ولا أدري إن كان في هذا البحث أيضاً 

إن كانت هناك صفوف مكتوبة ومعدة للترحيل لا يرحل معها صف العناوين وإن لم يكن كذلك فإن صف العناوين سيرحل بدلاً من الفراغ في الصفوف التالية

هذا والله أعلى وأعلم ...فاحرص على ألا تضغط على زر الترحيل إن لم يكن هناك شيء معدّ للترحيل

تقبلوا تحياتي والسلام عليكم...

[ياسر خليل أبو البراء]

أخي الكريم أبو حنين

إليك التعديل التالي

(لم أفهم طلبك الأخير ..كيف لا تحتوي ورقة العمل غير على خلية واحدة ..حاول تربط النقطة بخلية محددة تكون فارغة)

Sub TransferToSpecificSheet()
    Dim Cell As Range, T As String, LR As Long, LRT As Long
    Dim WS As Worksheet, Answer As Long
    
    Set WS = Sheets("1")
    LR = WS.Cells(35, 3).End(xlUp).Row
    T = WS.Range("A3").Value
    
    Application.ScreenUpdating = False
            If Not IsEmpty(WS.Range("A3")) Then
                Range("B6:G" & LR).Copy
                With Sheets(T)
                    LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1
                    .Cells(LRT, 2).PasteSpecial xlPasteValues
                End With
            
                Answer = MsgBox("هل تريد أن تمسح البيانات في ورقة 1 أم لا؟", vbYesNo + vbQuestion)
                If Answer = vbYes Then
                    Sheets("1").Activate
                    Sheets("1").Range("A3,C6:C35,F6:G35").Select
                    Selection.ClearContents
                Else: End If
            Else
                MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub
            End If
            Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[ياسر خليل أبو البراء]

السلام عليكم أخي أبو حنين الكريم:

من خلال نظرتي لملفات الترحيل التي رأيتها سابقاً ولا أدري إن كان في هذا البحث أيضاً 

إن كانت هناك صفوف مكتوبة ومعدة للترحيل لا يرحل معها صف العناوين وإن لم يكن كذلك فإن صف العناوين سيرحل بدلاً من الفراغ في الصفوف التالية

هذا والله أعلى وأعلم ...فاحرص على ألا تضغط على زر الترحيل إن لم يكن هناك شيء معدّ للترحيل

تقبلوا تحياتي والسلام عليكم...

أخي الحبيب أبو يوسف

يمكن معالجة تلك النقطة بسهولة بربط الكود بخلية محددة إذا كانت فارغة يتم الخروج من تنفيذ الكود ..

[۩◊۩ أبو حنين ۩◊۩]

اخى الحبيب ياسر 

كيف ذلك 

ما معنى بربط الكود بخلية محددة إذا كانت فارغة يتم الخروج من تنفيذ الكود

وكيف

تم تعديل يونيو 5, 2015 بواسطه ۩◊۩ أبو حنين ۩◊۩

[محمد حسن المحمد]

أخي الحبيب أبو يوسف

يمكن معالجة تلك النقطة بسهولة بربط الكود بخلية محددة إذا كانت فارغة يتم الخروج من تنفيذ الكود .. انتهى كلام أخي أبو البراء.

 

 

السلام عليكم أخي الحبيب ياسر وفقك الله إلى كل خير..  .عالم تخفى علينا كثير من مكنوناته ...تحلون ألغازه ...وتأطرونه ليكون مطواعاً

لقد ألان الله تعالى لداوود الحديد ...وأسال لسليمان عين القطر (النحاس المذاب) وها نحن نفتح أبصارنا وبصائرنا لندرك ما حولنا بهمة الطيبين أمثالكم

جزاكم الله خيراً..والسلام عليكم.

تم تعديل يونيو 5, 2015 بواسطه محمد حسن المحمد

[ياسر خليل أبو البراء]

أعني الخلية A3 مثلاً إذا كانت فارغة لا يتم الترحيل وهذا ما طبقته في المشاركة رقم 11

[۩◊۩ أبو حنين ۩◊۩]

اخى الحبيب ياسر

جزاك الله كل الخير 

كده الامور ذى الفل  بمجهودك ووقتك وجميع اعضاء المنتدى الكرام

جزاك الله كل الخير 

[ahmed eloony]

السلام عليكم وبارك الله فيكم لو سمحتم عندى بعض الاسئله لو تكرمتم 

الاول اريد كود ترحيل ل row  بعد  p16   يكون p 17  الخ                                                                                                                  
 

    Selection.Copy
    Range("p16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("d12").Select
    Selection.Copy
    Range("am16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D11").Select
    Selection.Copy
    Range("s16").Select
    ActiveSheet.Paste
    Range("H11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q16").Select
    ActiveSheet.Paste
    Range("H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R16").Select
    ActiveSheet.Paste
    Range("D15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("T16").Select
    ActiveSheet.Paste
    Range("D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X16").Select
    ActiveSheet.Paste
    Range("F15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("U16").Select
    ActiveSheet.Paste
    Range("H15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("V16").Select
    ActiveSheet.Paste
    Range("F16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Y16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=10
    Range("H16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Z16").Select
    ActiveSheet.Paste
    Range("D17").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-3
    Range("AB16").Select
    ActiveSheet.Paste
    Range("F17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC16").Select
    ActiveSheet.Paste
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AD16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=5
    Range("D18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AF16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("F18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-4
    Range("AG16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("H18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AH16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=14
    Range("D19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-13
    Range("AJ16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=13
    Range("F19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AK16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("H19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AL16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("I38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J38").Select
    ActiveSheet.Paste
    Range("L27").Select
   If Sheet1.Range("d11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d12").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
End If
End Sub

    

ثانيا كود لعدم الترحيل اذا كان فيه شى ناقص وليست رساله فقط انما تمنع بالفعل الترحيل وتمنع التكرار ايضا 

ثالثا انا بستخدم  داله voolkup فى بحث عن الفاتوره عندما اريد التعديل عليها تحذف الداله اريد التعديل عليها وترحيلها مره اخرى وتبقى الداله موجوده تعمل 

رابعا بعد البحث عن فاتوره اريدها . الفاتوره رقمها حيكون موجود  للبحث عنها فى خانه =Sheet1!C9 والجدول الموجود فيه الفاتوره حيكون فى شيت تانى بدايه الجدول =فاتوره!P15 وتنتهى =فاتوره!AO2060  واريد زر التعديل عليها واريد زر لاعادتها بعد الحذف و اريد  زر لحذفها  . ممكن حضرتك تعملى نموذج على البيانات دى وانا اكمله 

وجزاكم الله خيرا ونفع بكم واجزلكم بعطاءه 

[ahmed eloony]

في ١٣‏/٩‏/٢٠١١ at 21:08, عبدالله المجرب said:

هذا هو الكود

 

 

Sub OFFICNA()

Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet

Set ws = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

LR = ws.Range("a" & Rows.Count).End(xlUp).Row

LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("a2").Value = "" Then

MsgBox ("لا توجد بيانات لترحيلها")

Else

ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)

ws2.Select

End If

End Sub

هذا الجزء لتعريف أوراق العمل وتعريفها برمز إختصار اخترت ان يكون ws و ws2

 

Set ws = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws والتي هي Sheet1

 

LR = ws.Range("a" & Rows.Count).End(xlUp).Row

هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws2 والتي هي Sheet2

 

LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row

هذا شرط عدم الترحيل اذا كانت الخلية A2 فاضية وتظهر رسالة تنبيه بعدم التنبيه

 

If ws.Range("a2").Value = "" Then

MsgBox ("لا توجد بيانات لترحيلها")

في حال عدم تحقق شرط خلو الخلية A2 من البيانات يتم تنفيذ هذا الجزء وهو الخاص بعملية نسخ المدى A2: B مرتبطة بأخر صف فيه بيانات LR ويتم لصقها في ورقة البيانات المسمية WS2 في المدى A وأول صف فارغ في الورقة المرحل اليها ws2

 

ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)

هذا الجزء لاختيار ورقة العمل ws2 بعد الانتهاء من الترحيل

 

ws2.Select

 

ان شاء الله اكون وفقت في الشرح

أما بالنسبة لطلبك فهو غير واضح؟؟

جزاك الله خيرا وبارك الله فى حضرتك والاخوه العاملين فى الموقع 

طلبى الاخير انا ببحث فى خانه بستخدم فيها داله voolkup  فلما البيانات بتيجى بكون محتاج اعدل عليها فلما بكتب فى الخانه فالداله بتتمسح 

فانا عايز اعدل والداله تكون موجوده متتمسحش عشان عمليات البحث القادمه

 

[ahmed eloony]

في ١٣‏/٩‏/٢٠١١ at 21:08, عبدالله المجرب said:

هذا هو الكود

 

 

Sub OFFICNA()

Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet

Set ws = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

LR = ws.Range("a" & Rows.Count).End(xlUp).Row

LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("a2").Value = "" Then

MsgBox ("لا توجد بيانات لترحيلها")

Else

ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)

ws2.Select

End If

End Sub

هذا الجزء لتعريف أوراق العمل وتعريفها برمز إختصار اخترت ان يكون ws و ws2

 

Set ws = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws والتي هي Sheet1

 

LR = ws.Range("a" & Rows.Count).End(xlUp).Row

هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws2 والتي هي Sheet2

 

LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row

هذا شرط عدم الترحيل اذا كانت الخلية A2 فاضية وتظهر رسالة تنبيه بعدم التنبيه

 

If ws.Range("a2").Value = "" Then

MsgBox ("لا توجد بيانات لترحيلها")

في حال عدم تحقق شرط خلو الخلية A2 من البيانات يتم تنفيذ هذا الجزء وهو الخاص بعملية نسخ المدى A2: B مرتبطة بأخر صف فيه بيانات LR ويتم لصقها في ورقة البيانات المسمية WS2 في المدى A وأول صف فارغ في الورقة المرحل اليها ws2

 

ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)

هذا الجزء لاختيار ورقة العمل ws2 بعد الانتهاء من الترحيل

 

ws2.Select

 

ان شاء الله اكون وفقت في الشرح

أما بالنسبة لطلبك فهو غير واضح؟؟

جزاك الله خيرا وبارك الله فى حضرتك والاخوه العاملين فى الموقع 

طلبى الاخير انا ببحث فى خانه بستخدم فيها داله voolkup  فلما البيانات بتيجى بكون محتاج اعدل عليها فلما بكتب فى الخانه فالداله بتتمسح 

فانا عايز اعدل والداله تكون موجوده متتمسحش عشان عمليات البحث القادمه

 

[ahmed eloony]

في ١٤‏/١١‏/٢٠١٨ at 23:40, ahmed eloony said:

السلام عليكم وبارك الله فيكم لو سمحتم عندى بعض الاسئله لو تكرمتم 

الاول اريد كود ترحيل ل row  بعد  p16   يكون p 17  الخ                                                                                                                  
 

    Selection.Copy
    Range("p16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("d12").Select
    Selection.Copy
    Range("am16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D11").Select
    Selection.Copy
    Range("s16").Select
    ActiveSheet.Paste
    Range("H11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q16").Select
    ActiveSheet.Paste
    Range("H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R16").Select
    ActiveSheet.Paste
    Range("D15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("T16").Select
    ActiveSheet.Paste
    Range("D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X16").Select
    ActiveSheet.Paste
    Range("F15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("U16").Select
    ActiveSheet.Paste
    Range("H15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("V16").Select
    ActiveSheet.Paste
    Range("F16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Y16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=10
    Range("H16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Z16").Select
    ActiveSheet.Paste
    Range("D17").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-3
    Range("AB16").Select
    ActiveSheet.Paste
    Range("F17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC16").Select
    ActiveSheet.Paste
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AD16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=5
    Range("D18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AF16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("F18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-4
    Range("AG16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("H18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AH16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=14
    Range("D19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-13
    Range("AJ16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=13
    Range("F19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AK16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("H19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AL16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("I38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J38").Select
    ActiveSheet.Paste
    Range("L27").Select
   If Sheet1.Range("d11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d12").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
End If
End Sub

    

ثانيا كود لعدم الترحيل اذا كان فيه شى ناقص وليست رساله فقط انما تمنع بالفعل الترحيل وتمنع التكرار ايضا 

ثالثا انا بستخدم  داله voolkup فى بحث عن الفاتوره عندما اريد التعديل عليها تحذف الداله اريد التعديل عليها وترحيلها مره اخرى وتبقى الداله موجوده تعمل 

رابعا بعد البحث عن فاتوره اريدها . الفاتوره رقمها حيكون موجود  للبحث عنها فى خانه =Sheet1!C9 والجدول الموجود فيه الفاتوره حيكون فى شيت تانى بدايه الجدول =فاتوره!P15 وتنتهى =فاتوره!AO2060  واريد زر التعديل عليها واريد زر لاعادتها بعد الحذف و اريد  زر لحذفها  . ممكن حضرتك تعملى نموذج على البيانات دى وانا اكمله 

وجزاكم الله خيرا ونفع بكم واجزلكم بعطاءه 

 

6 ساعات مضت, ahmed eloony said:

جزاك الله خيرا وبارك الله فى حضرتك والاخوه العاملين فى الموقع 

طلبى الاخير انا ببحث فى خانه بستخدم فيها داله voolkup  فلما البيانات بتيجى بكون محتاج اعدل عليها فلما بكتب فى الخانه فالداله بتتمسح 

فانا عايز اعدل والداله تكون موجوده متتمسحش عشان عمليات البحث القادمه

 

 

myfile = "h:\12\" & Sheet1.Range("d9") & "-" & Sheet1.Range("h9") & ".pdf"
'حفظ الفاتوره بصيغه pdf
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile

مش عارف ايه المشكله فى الكود ده 

معلش حتعبكوا معايا 

معلش انا جديد فى الموقع وبكتب تعليقات وسعات مبلاقيهاش فممكن تلاقيها متكرره

محتاج كود لعدم تكرار رقم الفاتوره وكود للتعديل وكود للحذف وكود لاعادتها بعد الحذف

ودا حيكون على الاكواد دى حضرتك 

Sub OFFICNA()

Dim LR2 As Long, ws As Worksheet

Set ws = Sheets("Sheet1")

LR2 = ws.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("d11").Value = "" Then

MsgBox ("من فضلك اكمل البيانات")

Else

ws.Range("a2:a2").Copy ws.Range("a" & LR2 + 1)

ws.Select
ws.Range("d9:d9").Copy ws.Range("p" & LR2 + 1)

ws.Select
ws.Range("d11:d11").Copy ws.Range("s" & LR2 + 1)
ws.Select

ws.Range("d12:d12").Copy ws.Range("am" & LR2 + 1)
ws.Select

ws.Range("h9:h9").Copy ws.Range("r" & LR2 + 1)
ws.Select

ws.Range("h11:h11").Copy ws.Range("q" & LR2 + 1)
ws.Select

ws.Range("d15:d15").Copy ws.Range("t" & LR2 + 1)
ws.Select
ws.Range("d16:d16").Copy ws.Range("x" & LR2 + 1)
ws.Select

ws.Range("d17:d17").Copy ws.Range("ab" & LR2 + 1)
ws.Select
ws.Range("d18:d18").Copy ws.Range("af" & LR2 + 1)
ws.Select

ws.Range("d19:d19").Copy ws.Range("aj" & LR2 + 1)
ws.Select

ws.Range("f15:f15").Copy ws.Range("u" & LR2 + 1)
ws.Select
ws.Range("f16:f16").Copy ws.Range("y" & LR2 + 1)
ws.Select

ws.Range("f17:f17").Copy ws.Range("ac" & LR2 + 1)
ws.Select

ws.Range("f18:f18").Copy ws.Range("ag" & LR2 + 1)
ws.Select

ws.Range("f19:f19").Copy ws.Range("ak" & LR2 + 1)
ws.Select

ws.Range("h15:h15").Copy ws.Range("v" & LR2 + 1)
ws.Select

ws.Range("h16:h16").Copy ws.Range("z" & LR2 + 1)
ws.Select

ws.Range("h17:h17").Copy ws.Range("ad" & LR2 + 1)
ws.Select

ws.Range("h18:h18").Copy ws.Range("ah" & LR2 + 1)
ws.Select

ws.Range("h19:h19").Copy ws.Range("al" & LR2 + 1)

ws.Select

اخر مشكله مشكله داله البحث لما بتستدعى بيانات فى الخانه لو انا عدلت عليها يعنى مثلا رقم 3 خليته انا 4 عشان اعدل عليها فالداله بتتمسح عايزلها حل 

وشكرا لتعب حضرتك معايا

 

تم تعديل نوفمبر 18, 2018 بواسطه ahmed eloony

[ahmed eloony]

في ١٤‏/١١‏/٢٠١٨ at 23:40, ahmed eloony said:

السلام عليكم وبارك الله فيكم لو سمحتم عندى بعض الاسئله لو تكرمتم 

الاول اريد كود ترحيل ل row  بعد  p16   يكون p 17  الخ                                                                                                                  
 

    Selection.Copy
    Range("p16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("d12").Select
    Selection.Copy
    Range("am16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D11").Select
    Selection.Copy
    Range("s16").Select
    ActiveSheet.Paste
    Range("H11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q16").Select
    ActiveSheet.Paste
    Range("H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R16").Select
    ActiveSheet.Paste
    Range("D15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("T16").Select
    ActiveSheet.Paste
    Range("D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X16").Select
    ActiveSheet.Paste
    Range("F15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("U16").Select
    ActiveSheet.Paste
    Range("H15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("V16").Select
    ActiveSheet.Paste
    Range("F16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Y16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=10
    Range("H16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Z16").Select
    ActiveSheet.Paste
    Range("D17").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-3
    Range("AB16").Select
    ActiveSheet.Paste
    Range("F17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC16").Select
    ActiveSheet.Paste
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AD16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=5
    Range("D18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AF16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("F18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-4
    Range("AG16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=4
    Range("H18").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-9
    Range("AH16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=14
    Range("D19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-13
    Range("AJ16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=13
    Range("F19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AK16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("H19").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=-19
    Range("AL16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=19
    Range("I38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J38").Select
    ActiveSheet.Paste
    Range("L27").Select
   If Sheet1.Range("d11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("d12").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h11").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
   End If
   If Sheet1.Range("h9").Value = "" Then
   MsgBox ("خطا فى ادخال البيانات")
   Else
End If
End Sub

    

ثانيا كود لعدم الترحيل اذا كان فيه شى ناقص وليست رساله فقط انما تمنع بالفعل الترحيل وتمنع التكرار ايضا 

ثالثا انا بستخدم  داله voolkup فى بحث عن الفاتوره عندما اريد التعديل عليها تحذف الداله اريد التعديل عليها وترحيلها مره اخرى وتبقى الداله موجوده تعمل 

رابعا بعد البحث عن فاتوره اريدها . الفاتوره رقمها حيكون موجود  للبحث عنها فى خانه =Sheet1!C9 والجدول الموجود فيه الفاتوره حيكون فى شيت تانى بدايه الجدول =فاتوره!P15 وتنتهى =فاتوره!AO2060  واريد زر التعديل عليها واريد زر لاعادتها بعد الحذف و اريد  زر لحذفها  . ممكن حضرتك تعملى نموذج على البيانات دى وانا اكمله 

وجزاكم الله خيرا ونفع بكم واجزلكم بعطاءه 

 

17 ساعات مضت, ahmed eloony said:

جزاك الله خيرا وبارك الله فى حضرتك والاخوه العاملين فى الموقع 

طلبى الاخير انا ببحث فى خانه بستخدم فيها داله voolkup  فلما البيانات بتيجى بكون محتاج اعدل عليها فلما بكتب فى الخانه فالداله بتتمسح 

فانا عايز اعدل والداله تكون موجوده متتمسحش عشان عمليات البحث القادمه

 

 

[أحمد يوسف]

أهلا بك اخى الكريم فى المنتدى

عليك برفع الملف نفسه بارك الله فيك

[ahmed eloony]

10 ساعات مضت, ahmed eloony said:

 

 

myfile = "h:\12\" & Sheet1.Range("d9") & "-" & Sheet1.Range("h9") & ".pdf"
'حفظ الفاتوره بصيغه pdf
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile

مش عارف ايه المشكله فى الكود ده 

معلش حتعبكوا معايا 

معلش انا جديد فى الموقع وبكتب تعليقات وسعات مبلاقيهاش فممكن تلاقيها متكرره

محتاج كود لعدم تكرار رقم الفاتوره وكود للتعديل وكود للحذف وكود لاعادتها بعد الحذف

ودا حيكون على الاكواد دى حضرتك 

Sub OFFICNA()

Dim LR2 As Long, ws As Worksheet

Set ws = Sheets("Sheet1")

LR2 = ws.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("d11").Value = "" Then

MsgBox ("من فضلك اكمل البيانات")

Else

ws.Range("a2:a2").Copy ws.Range("a" & LR2 + 1)

ws.Select
ws.Range("d9:d9").Copy ws.Range("p" & LR2 + 1)

ws.Select
ws.Range("d11:d11").Copy ws.Range("s" & LR2 + 1)
ws.Select

ws.Range("d12:d12").Copy ws.Range("am" & LR2 + 1)
ws.Select

ws.Range("h9:h9").Copy ws.Range("r" & LR2 + 1)
ws.Select

ws.Range("h11:h11").Copy ws.Range("q" & LR2 + 1)
ws.Select

ws.Range("d15:d15").Copy ws.Range("t" & LR2 + 1)
ws.Select
ws.Range("d16:d16").Copy ws.Range("x" & LR2 + 1)
ws.Select

ws.Range("d17:d17").Copy ws.Range("ab" & LR2 + 1)
ws.Select
ws.Range("d18:d18").Copy ws.Range("af" & LR2 + 1)
ws.Select

ws.Range("d19:d19").Copy ws.Range("aj" & LR2 + 1)
ws.Select

ws.Range("f15:f15").Copy ws.Range("u" & LR2 + 1)
ws.Select
ws.Range("f16:f16").Copy ws.Range("y" & LR2 + 1)
ws.Select

ws.Range("f17:f17").Copy ws.Range("ac" & LR2 + 1)
ws.Select

ws.Range("f18:f18").Copy ws.Range("ag" & LR2 + 1)
ws.Select

ws.Range("f19:f19").Copy ws.Range("ak" & LR2 + 1)
ws.Select

ws.Range("h15:h15").Copy ws.Range("v" & LR2 + 1)
ws.Select

ws.Range("h16:h16").Copy ws.Range("z" & LR2 + 1)
ws.Select

ws.Range("h17:h17").Copy ws.Range("ad" & LR2 + 1)
ws.Select

ws.Range("h18:h18").Copy ws.Range("ah" & LR2 + 1)
ws.Select

ws.Range("h19:h19").Copy ws.Range("al" & LR2 + 1)

ws.Select

اخر مشكله مشكله داله البحث لما بتستدعى بيانات فى الخانه لو انا عدلت عليها يعنى مثلا رقم 3 خليته انا 4 عشان اعدل عليها فالداله بتتمسح عايزلها حل 

وشكرا لتعب حضرتك معايا

 

]دى مشكله فى الحفظ 

[ahmed eloony]

31 دقائق مضت, أحمد يوسف said:

أهلا بك اخى الكريم فى المنتدى

عليك برفع الملف نفسه بارك الله فيك

حاضر اخى بارك الله فيك 

فى sheet (بحث)     محتاج احافظ على داله voolkup او استبدالها بكود بحث

ومحتاج كود تعديل عليها حتترحل بعد تعديلها ل sheet 1  من بدايه الخانه p16 

وحفظها فى myfile = "H:\013\" & Sheet3.Range("c9") & "-""& Sheet3.Range("g9")".pdf"

وكود لحذفها   وكود لاعادتها من الحذف لو امكن

دا بالنسبه لشيت (بحث)

بالنسبه لشيت sheet1   محتاج احط فى كود الترحيل عدم التكرار

و بحث وتعديل فى sheet 1   مش عايز اغير فيها حاجه دا بعد اذن حضرتك 

ومحتاج اعرف لو عندى معادله اذاى احطها فى اليوزر فورم او فى vpa

وجزاك الله خيرا  وجزاك فردوسا 

الاحدث.xlsm

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

بوركت اخى 

تم تعديل نوفمبر 18, 2018 بواسطه ahmed eloony

[ahmed eloony]

6 ساعات مضت, ahmed eloony said:

حاضر اخى بارك الله فيك 

فى sheet (بحث)     محتاج احافظ على داله voolkup او استبدالها بكود بحث من الخانه p16 sheet1 الى ao 2060 نفس الشيت

ومحتاج كود تعديل عليها حتترحل بعد تعديلها ل sheet 1  من بدايه الخانه p16 

وحفظها فى myfile = "H:\013\" & Sheet3.Range("c9") & "-""& Sheet3.Range("g9")".pdf"

وكود لحذفها   وكود لاعادتها من الحذف لو امكن

دا بالنسبه لشيت (بحث)

بالنسبه لشيت sheet1   محتاج احط فى كود الترحيل عدم التكرار

و بحث وتعديل فى sheet 1   مش عايز اغير فيها حاجه دا بعد اذن حضرتك 

ومحتاج اعرف لو عندى معادله اذاى احطها فى اليوزر فورم او فى vpa

وجزاك الله خيرا  وجزاك فردوسا 

الاحدث.xlsm

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

بوركت اخى 

17 ساعات مضت, ahmed eloony said:

 

 

myfile = "h:\12\" & Sheet1.Range("d9") & "-" & Sheet1.Range("h9") & ".pdf"
'حفظ الفاتوره بصيغه pdf
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile

مش عارف ايه المشكله فى الكود ده 

معلش حتعبكوا معايا 

معلش انا جديد فى الموقع وبكتب تعليقات وسعات مبلاقيهاش فممكن تلاقيها متكرره

محتاج كود لعدم تكرار رقم الفاتوره وكود للتعديل وكود للحذف وكود لاعادتها بعد الحذف

ودا حيكون على الاكواد دى حضرتك 

Sub OFFICNA()

Dim LR2 As Long, ws As Worksheet

Set ws = Sheets("Sheet1")

LR2 = ws.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("d11").Value = "" Then

MsgBox ("من فضلك اكمل البيانات")

Else

ws.Range("a2:a2").Copy ws.Range("a" & LR2 + 1)

ws.Select
ws.Range("d9:d9").Copy ws.Range("p" & LR2 + 1)

ws.Select
ws.Range("d11:d11").Copy ws.Range("s" & LR2 + 1)
ws.Select

ws.Range("d12:d12").Copy ws.Range("am" & LR2 + 1)
ws.Select

ws.Range("h9:h9").Copy ws.Range("r" & LR2 + 1)
ws.Select

ws.Range("h11:h11").Copy ws.Range("q" & LR2 + 1)
ws.Select

ws.Range("d15:d15").Copy ws.Range("t" & LR2 + 1)
ws.Select
ws.Range("d16:d16").Copy ws.Range("x" & LR2 + 1)
ws.Select

ws.Range("d17:d17").Copy ws.Range("ab" & LR2 + 1)
ws.Select
ws.Range("d18:d18").Copy ws.Range("af" & LR2 + 1)
ws.Select

ws.Range("d19:d19").Copy ws.Range("aj" & LR2 + 1)
ws.Select

ws.Range("f15:f15").Copy ws.Range("u" & LR2 + 1)
ws.Select
ws.Range("f16:f16").Copy ws.Range("y" & LR2 + 1)
ws.Select

ws.Range("f17:f17").Copy ws.Range("ac" & LR2 + 1)
ws.Select

ws.Range("f18:f18").Copy ws.Range("ag" & LR2 + 1)
ws.Select

ws.Range("f19:f19").Copy ws.Range("ak" & LR2 + 1)
ws.Select

ws.Range("h15:h15").Copy ws.Range("v" & LR2 + 1)
ws.Select

ws.Range("h16:h16").Copy ws.Range("z" & LR2 + 1)
ws.Select

ws.Range("h17:h17").Copy ws.Range("ad" & LR2 + 1)
ws.Select

ws.Range("h18:h18").Copy ws.Range("ah" & LR2 + 1)
ws.Select

ws.Range("h19:h19").Copy ws.Range("al" & LR2 + 1)

ws.Select

اخر مشكله مشكله داله البحث لما بتستدعى بيانات فى الخانه لو انا عدلت عليها يعنى مثلا رقم 3 خليته انا 4 عشان اعدل عليها فالداله بتتمسح عايزلها حل 

وشكرا لتعب حضرتك معايا

 

]دى مشكله فى الحفظ 

6 ساعات مضت, ahmed eloony said:

حاضر اخى بارك الله فيك 

فى sheet (بحث)     محتاج احافظ على داله voolkup او استبدالها بكود بحث من الخانه p16 sheet1 الى ao 2060 نفس الشيت

ومحتاج كود تعديل عليها حتترحل بعد تعديلها ل sheet 1  من بدايه الخانه p16 

وحفظها فى myfile = "H:\013\" & Sheet3.Range("c9") & "-""& Sheet3.Range("g9")".pdf"

وكود لحذفها   وكود لاعادتها من الحذف لو امكن

دا بالنسبه لشيت (بحث)

بالنسبه لشيت sheet1   محتاج احط فى كود الترحيل عدم التكرار

و بحث وتعديل فى sheet 1   مش عايز اغير فيها حاجه دا بعد اذن حضرتك 

ومحتاج اعرف لو عندى معادله اذاى احطها فى اليوزر فورم او فى vpa

وجزاك الله خيرا  وجزاك فردوسا 

الاحدث.xlsm

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

بوركت اخى 

18 ساعات مضت, ahmed eloony said:

 

 

myfile = "h:\12\" & Sheet1.Range("d9") & "-" & Sheet1.Range("h9") & ".pdf"
'حفظ الفاتوره بصيغه pdf
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile

مش عارف ايه المشكله فى الكود ده 

معلش حتعبكوا معايا 

معلش انا جديد فى الموقع وبكتب تعليقات وسعات مبلاقيهاش فممكن تلاقيها متكرره

محتاج كود لعدم تكرار رقم الفاتوره وكود للتعديل وكود للحذف وكود لاعادتها بعد الحذف

ودا حيكون على الاكواد دى حضرتك 

Sub OFFICNA()

Dim LR2 As Long, ws As Worksheet

Set ws = Sheets("Sheet1")

LR2 = ws.Range("a" & Rows.Count).End(xlUp).Row

If ws.Range("d11").Value = "" Then

MsgBox ("من فضلك اكمل البيانات")

Else

ws.Range("a2:a2").Copy ws.Range("a" & LR2 + 1)

ws.Select
ws.Range("d9:d9").Copy ws.Range("p" & LR2 + 1)

ws.Select
ws.Range("d11:d11").Copy ws.Range("s" & LR2 + 1)
ws.Select

ws.Range("d12:d12").Copy ws.Range("am" & LR2 + 1)
ws.Select

ws.Range("h9:h9").Copy ws.Range("r" & LR2 + 1)
ws.Select

ws.Range("h11:h11").Copy ws.Range("q" & LR2 + 1)
ws.Select

ws.Range("d15:d15").Copy ws.Range("t" & LR2 + 1)
ws.Select
ws.Range("d16:d16").Copy ws.Range("x" & LR2 + 1)
ws.Select

ws.Range("d17:d17").Copy ws.Range("ab" & LR2 + 1)
ws.Select
ws.Range("d18:d18").Copy ws.Range("af" & LR2 + 1)
ws.Select

ws.Range("d19:d19").Copy ws.Range("aj" & LR2 + 1)
ws.Select

ws.Range("f15:f15").Copy ws.Range("u" & LR2 + 1)
ws.Select
ws.Range("f16:f16").Copy ws.Range("y" & LR2 + 1)
ws.Select

ws.Range("f17:f17").Copy ws.Range("ac" & LR2 + 1)
ws.Select

ws.Range("f18:f18").Copy ws.Range("ag" & LR2 + 1)
ws.Select

ws.Range("f19:f19").Copy ws.Range("ak" & LR2 + 1)
ws.Select

ws.Range("h15:h15").Copy ws.Range("v" & LR2 + 1)
ws.Select

ws.Range("h16:h16").Copy ws.Range("z" & LR2 + 1)
ws.Select

ws.Range("h17:h17").Copy ws.Range("ad" & LR2 + 1)
ws.Select

ws.Range("h18:h18").Copy ws.Range("ah" & LR2 + 1)
ws.Select

ws.Range("h19:h19").Copy ws.Range("al" & LR2 + 1)

ws.Select

اخر مشكله مشكله داله البحث لما بتستدعى بيانات فى الخانه لو انا عدلت عليها يعنى مثلا رقم 3 خليته انا 4 عشان اعدل عليها فالداله بتتمسح عايزلها حل 

وشكرا لتعب حضرتك معايا

 

]دى مشكله فى الحفظ 

[ahmed eloony]

21 ساعات مضت, ahmed eloony said:

]دى مشكله فى الحفظ 

]دى مشكله فى الحفظ