كيفية انشاء مايكرو لنسخ قيم معينة من عدة صفحات الى صفحة واحده ؟؟؟

[اسامة ابو عمر]

السلام عليكم

دلوقتي انا عندي 4 صفحات

صفحة منهم رئيسة الماستر اللي رح اجمع المعلومات فيها من ال3 صفحات التانية

الصفجة الرئيسية اسمها IPD

أول حاجه عايز اخد من الصفحة الاولى اللي اسمها LFP  من العامود J الى العامود  S وانسخهم بصفحة ال IPD على نفس مكان الاعمدة

تاني حاجه عايز اخد من الصفحة الثانية اللي اسمها LTR من العامود T الى العامود  AB وانسخهم بصفحة ال IPD على نفس مكان الاعمدة

ثالث حاجه عايز اخد من الصفحة الثالثة اللي اسمها LHL من العامود AC الى العامود  AKوانسخهم بصفحة ال IPD على نفس مكان الاعمدة 

بعد النسخ عندي حاجتين

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

تاني حاجه والمهم  دلوقتي في عندي الاعمدة من A الى I وده مشتركة بين ال3 صفحات ودي بس حيكون فيه تكرار في العامود A  انا عايز لما يكون فيه تكرار ياخد اول سطر من المكرر

 

ممكن ميكونش الموضوع عايز مايكرو او برمجة ؟؟

ارجو المساعدة 

osamahreport1.rar

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

السلام عليكم

هذا بالنسبة للترحيل فقط

 

osamahreport2.rar

[اسامة ابو عمر]

15 دقائق مضت, أخوكم في الله said:

السلام عليكم

هذا بالنسبة للترحيل فقط

 

osamahreport2.rar

شكرا ليك يا باشا بس شايف ان الترحيل كل ما اضغط كوبي بيكرر 

واول صف مش بيجي عليه معلومات

هل ممكن ان نصل لنتيجة افضل ؟؟؟

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

هل تريد عدم تكرار البيانات

عد الى الموديل ستجد الجملة   :    ( 1 +   )   مكررة 6 مرات قم بمسحها

Dim Sh_LFP As Worksheet
Dim Sh_LTR As Worksheet
Dim Sh_LHL As Worksheet
Dim Sh_IPD As Worksheet

Sub Copy1()
Application.ScreenUpdating = False
Dim R_LFP As Long, LastR_LFP As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LFP = Sheets("LFP")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "J").End(xlUp).Row
LastR_LFP = Sh_LFP.Cells(Rows.Count, "J").End(xlUp).Row
For R_LFP = 2 To LastR_LFP
            Sh_LFP.Range("J" & R_LFP).Resize(1, 10).Copy
            Sh_IPD.Range("J" & LastR_IPD).PasteSpecial xlPasteValues

            LastR_IPD = LastR_IPD + 1
           If R_LFP = LastR_LFP Then Copy2
    Next
End Sub

Sub Copy2()
Dim R_LTR As Long, LastR_LTR As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LTR = Sheets("LTR")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "T").End(xlUp).Row
LastR_LTR = Sh_LTR.Cells(Rows.Count, "T").End(xlUp).Row
For R_LTR = 2 To LastR_LTR
            Sh_LTR.Range("T" & R_LTR).Resize(1, 9).Copy
            Sh_IPD.Range("T" & LastR_IPD).PasteSpecial xlPasteValues

            LastR_IPD = LastR_IPD + 1
            If R_LTR = LastR_LTR Then Copy3
    Next
End Sub

Sub Copy3()
Dim R_LHL As Long, LastR_LHL As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LHL = Sheets("LHL")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "AC").End(xlUp).Row
LastR_LHL = Sh_LHL.Cells(Rows.Count, "AC").End(xlUp).Row
For R_LHL = 2 To LastR_LHL
            Sh_LHL.Range("AC" & R_LHL).Resize(1, 9).Copy
            Sh_IPD.Range("AC" & LastR_IPD).PasteSpecial xlPasteValues
            LastR_IPD = LastR_IPD + 1
    Next
Application.ScreenUpdating = False
End Sub

 

تم تعديل أبريل 12, 2016 بواسطه أخوكم في الله

[اسامة ابو عمر]

1 ساعه مضت, أخوكم في الله said:

هل تريد عدم تكرار البيانات

عد الى الموديل ستجد الجملة   :    ( 1 +   )   مكررة 6 مرات قم بمسحها

Dim Sh_LFP As Worksheet
Dim Sh_LTR As Worksheet
Dim Sh_LHL As Worksheet
Dim Sh_IPD As Worksheet

Sub Copy1()
Application.ScreenUpdating = False
Dim R_LFP As Long, LastR_LFP As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LFP = Sheets("LFP")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "J").End(xlUp).Row
LastR_LFP = Sh_LFP.Cells(Rows.Count, "J").End(xlUp).Row
For R_LFP = 2 To LastR_LFP
            Sh_LFP.Range("J" & R_LFP).Resize(1, 10).Copy
            Sh_IPD.Range("J" & LastR_IPD).PasteSpecial xlPasteValues

            LastR_IPD = LastR_IPD + 1
           If R_LFP = LastR_LFP Then Copy2
    Next
End Sub

Sub Copy2()
Dim R_LTR As Long, LastR_LTR As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LTR = Sheets("LTR")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "T").End(xlUp).Row
LastR_LTR = Sh_LTR.Cells(Rows.Count, "T").End(xlUp).Row
For R_LTR = 2 To LastR_LTR
            Sh_LTR.Range("T" & R_LTR).Resize(1, 9).Copy
            Sh_IPD.Range("T" & LastR_IPD).PasteSpecial xlPasteValues

            LastR_IPD = LastR_IPD + 1
            If R_LTR = LastR_LTR Then Copy3
    Next
End Sub

Sub Copy3()
Dim R_LHL As Long, LastR_LHL As Long
Dim R_IPD As Long, LastR_IPD As Long
Set Sh_LHL = Sheets("LHL")
Set Sh_IPD = Sheets("IPD")
LastR_IPD = Sh_IPD.Cells(Rows.Count, "AC").End(xlUp).Row
LastR_LHL = Sh_LHL.Cells(Rows.Count, "AC").End(xlUp).Row
For R_LHL = 2 To LastR_LHL
            Sh_LHL.Range("AC" & R_LHL).Resize(1, 9).Copy
            Sh_IPD.Range("AC" & LastR_IPD).PasteSpecial xlPasteValues
            LastR_IPD = LastR_IPD + 1
    Next
Application.ScreenUpdating = False
End Sub

 

شكرا ليك يا باشا

كده تقريبا نص الحل

فاضل النص الثاني 

هل يمكن ان يكون هناك نسخ اوتوماتيكي كل يوم ام لازم يكون النسخ عن طريق الزر ده ؟؟؟

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

الان, اسامة ابو عمر said:

شكرا ليك يا باشا

كده تقريبا نص الحل

فاضل النص الثاني 

هل يمكن ان يكون هناك نسخ اوتوماتيكي كل يوم ام لازم يكون النسخ عن طريق الزر ده ؟؟؟

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

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

يعني لما انسخ النهارده البيانات وبكره انسخ البيانات الجديده لازم مايخدش البيانات القديمة تاني مره

[اسامة ابو عمر]

up