اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود ترحيل الى اكثر من شبت


الردود الموصى بها

السلام عليكم

الساده الكرام والاخوة الافاضل

ارجو المساعده فى عمل كود ترحيل على الاسس التاليه

الشيت المراد الترحيل منه هو شيت transe

1-     الرقم هو رقم الشيت ورقم الموظف  اى بتم ترحيل البيانات الى الشيت المسى بالرقم   اى عندما يكون الرقم 134 يتم ترحيل البيانات التى بالصف الى شبت 134 وهكذا

2-     يتم ترحيل الخلايا التى باللاعمده B-C-E-F-G   ولا يرحل العمودD الى الشيت المراد  ابتداء من B20 ,C20 E20 F20 G20  

3-     يكون التحيل متوالى اى عندما يتم الترحيل فى شيت 134 يكون اسفل اى ترحيل من قبل

4-     الشيتات هو ارقام الموظفين اى اريد الترحيل ان يشمل جميع الشيتات

اخيرا .. الدعم الفنى كلمه السر له 1111

كلمه سر فك الشيتات هى 1111

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

علاج طارق2.rar

رابط هذا التعليق
شارك

السلام عليكم

الاخوة الكرام

وجت حل قريب للموضع 

ارجو المساعده فى تطبيقة

لاخ ابو حنبن اكرمة الله 

http://www.officena.net/ib/index.php?showtopic=51425&hl=%2Bترحيل+%2Bالى+%2Bعدة+%2Bاوراق

رابط هذا التعليق
شارك

تفضل أخي أبو حنين الكود التالي

Sub TransferData()
    Dim WS As Worksheet
    Dim I As Integer
    Dim LR As Long, LR2 As Long
    
    Set WS = ActiveWorkbook.Worksheets("transe")
    LR = WS.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
        For I = 4 To LR
            For Each WS In ActiveWorkbook.Worksheets
                LR2 = WS.Range("B" & Rows.Count).End(xlUp).Row
                If Cells(I, 1).Value = WS.Name Then
                   WS.Cells(LR2, 2).Offset(1).Value = Cells(I, 2).Value
                   WS.Cells(LR2, 3).Offset(1).Value = Cells(I, 3).Value
                   WS.Cells(LR2, 5).Offset(1).Value = Cells(I, 5).Value
                   WS.Cells(LR2, 6).Offset(1).Value = Cells(I, 6).Value
                   WS.Cells(LR2, 7).Offset(1).Value = Cells(I, 7).Value
                End If
            Next WS
            
        Next I
    Application.ScreenUpdating = True
End Sub


لكن يجب أولا إلغاء دمج الخلايا في الشيتات كلها .. حاولت أخلي الدمج زي ما هو لكن لم تضبط معي نهائيا

يرجى إلغاء الدمج وعد الاعتماد عليه لأنه يتسبب في مشاكل مع الأكواد

رابط هذا التعليق
شارك

السلام عليكم 

اخى ياسر ... 

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

يتم مسح محتوى الخلايا  A4& C4&E4&G4 الى الصف 26

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

رابط هذا التعليق
شارك

لم أفهم طلبك بشكل واضح يعني ايه مسح إلى .. تقصد نقل البيانات إلى مكان آخر ثم مسحها من مكانها ..

يرجى مراعاة الدقة في اللفظ ..

:rol:

رابط هذا التعليق
شارك

نعم اخى الحبيب 

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

ولاكن من خلال مسح محتوى الخلايا  A4& C4&E4&G4 الى الصف 26

وذلك لكون الاعمده B &D&F

بها معادلات 

هل يمكن عمل ذلك

وجزاك الله كل الخير على مجهودك وسعيك معى

رابط هذا التعليق
شارك

إذا مكانش فيها إرهاق ليك قم برفع الملف بعد تعديلك للخلايا المدمجة .. عشان بصراحة أنا من كارهي الخلايا المدمجة لأنها تسبب مشاكل كثيرة جدا

ارفق الملف بعد التعديل .. حتى أستطيع العمل من آخر نقطة .. توفيرا للوقت أخي الحبيب أبو حنين

رابط هذا التعليق
شارك

السلام عليكم 

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

مرفق الملف 

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

نفس الكود على ان يتم ترحيل O4 ال 46 من شيت transa الى الشيت فى O6 الى S6

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

اسم المستخدم الدعم الفنى 1111

حماية الشيتات 1111

 

علاج طارق4 .rar

تم تعديل بواسطه ۩◊۩ أبو حنين ۩◊۩
رابط هذا التعليق
شارك

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

 

بعد اذن استاذنا ياسر خليل

 

مرفق الكود

Sub trhil_to_sheet()
Dim FS As Worksheet, TS As Worksheet
Dim FR, TR, ER1, ER2
Dim TSN
Set FS = Sheets("transe")
FS.Unprotect
For FR = 3 To FS.UsedRange.Rows.Count
TSN = FS.Cells(FR, 1).Text
If TSN = "" Then GoTo 9
For TS1 = 1 To Sheets.Count
If Sheets(TS1).Name = TSN Then
Set TS = Sheets(TSN)
TR = TS.Range("B9999").End(xlUp).Row + 1
If TR < 20 Then TR = 20
TS.Unprotect
    FS.Range("B" & FR & ":C" & FR).Copy
     TS.Range("B" & TR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    FS.Range("E" & FR & ":G" & FR).Copy
    TS.Range("E" & TR).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    FS.Range("B" & FR & ":C" & FR & ",E" & FR & ":G" & FR).ClearContents
    GoTo 9
End If
Next TS1
9 Next FR



    ActiveWorkbook.Save


End Sub


  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

سلمت بداك اخى الحبيب احمد 

حل جميل جدا وواقى بلاضاقه الى حل الاخ الحبيب باسر سلمت بداكم 

وبقى طلب لا اريد حذف محتوى العمود F لكونة به معادلات ومرتبط بالعمود A وبهما معادلات 

هل يمكن عمل ذلك

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

رابط هذا التعليق
شارك

السلام عليكم
الاخ الكريم احمد
جزاك الله خيرا على وقتك ومجهودك معى
اخى الحبيب
حاولت تكرار الكود ( اضافة كود جديد للعلاج الشخصى )على اساس ان اسم الشيت المراد الترحيل اليه  سوف ستم ادخالة فى العمود N
ويتم نقل او ترحيل الاعمده O&p&Q&R&S
الى نفس الاعمدة فى الشيت المراد نقل البيانات اليه ولاكنى لم افلح
ارجو التكرم ومساعدتى فى تكرار نفس الكود على اساس
1- اسم الشيت المراد تقل البياات اليه فى العمود N إبتداء من الخلية N3
2- ويتم نقل الاعمده O&P&Q&R&S الى الشيت المراد والى الاعمده O&P&Q&R&S ابتداء من الصف السادس اى الى O6&P6&Q6&R6&S6
مع باقى الكود من مسح البيانات بعد الترحيل
اخى الحبيب ارجو ان تتقبل عزرى فى اثقالى عليك

فى حفظ الله وامنه

 

 

TIST.rar

تم تعديل بواسطه ۩◊۩ أبو حنين ۩◊۩
رابط هذا التعليق
شارك

السلام عليكم

اخى الكريم احمد زمان 

بعد تتبع شرحك الوافى تمكنت من عمل الكود واظنة سليم

ارجو اللنظر اليه ... لعل به خطاء لم اتاركة

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

TIST1.rar

رابط هذا التعليق
شارك

السلام عليكم

الاخ الكريم احمد زمان 

اولا اشكرك على الكود الذى قمت بع من اجلى

واسالك سعة صدرك معى حيث يوجد اضاقات ارجو تحقيقها

  1. يتم الترحيل من شيت transe على اساس اسم الشيت الذى بالعمود A ا
  2. عند ما يكون العمود B  فى شيت transe يحتوى على كلمة Family يتم ترحيل الاعمده

C  الى B الى الشيت الذى اسمه موجود فى العمود A  فى شيت transe

D الى C

E الى D

F الى E  ابتداء من الصف رقم 19

 

  1. وعند ما يكون العمود B  فى شيت transe يحتوى على كلمة Personal يتم ترحيل الاعمده

C  الى H الى الشيت الذى اسمه موجود فى العمود A  فى شيت transe

 E الى I

F الى J  ابتداء من الصف رقم 6

مع مسح المدخلات فى العمود D & E & F  فى شيت transe بعد الترحيل

 

الدعم الفنى  كلمه السر 1111

فك حماية الشيتات       1111

علاج حقول طارق.rar

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information