ترحيل بيانات ترحيل بيانات أعمدة محددة و بدون صفوف فارغة لورقة عمل جديدة

**ناصرالمصرى** · نوفمبر 17, 2015

اخوانى الافاضل

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

الطلب بعد إذن حضراتكم على النحو المبين بالمرفق التالى

أرغب بكود ينفذ عملية الترحيل بدون الصفوف الفارغة

الظاهرة بين كل مجموعة أسماء من كلا العمودين

C و AM بداية من الصف 8 حتى أخر صف به بيانات بالورقة " salary"

الى كلا العمودين J و K بالورقة " Total "

شاكر فضل حضراتكم

تقبلوا وافر تقديرى واحترامى

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة.rar

**الـعيدروس** · نوفمبر 18, 2015

السلام عليكم

Sub Ali_T()
 Set Ws = Sheets("salary")
  L = Split(Ws.UsedRange.Address, "$")(4)
  Union(Ws.Range("C8:C" & L).SpecialCells(2), _
  Ws.Range("Am8:Am" & L).SpecialCells(-4123)).Copy Sheets("Total ").[J8]
End Sub

**ناصرالمصرى** · نوفمبر 18, 2015

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

أخى الكريم العيدروس

برجاء الافادة بمرفق نظرا لوجود رسالة خطأ بهذين السطرين

  Union(Ws.Range("C8:C" & L).SpecialCells(2), _
  Ws.Range("Am8:Am" & L).SpecialCells(-4123)).Copy Sheets("Total ").[J8]

شاكر فضلك مع قبول وافر تقديرى واحترامى

**ناصرالمصرى** · نوفمبر 18, 2015

للرفع

**الـعيدروس** · نوفمبر 18, 2015

مانوع الاوفيس عندك 2007 ام 2003

عندي 2007

**ياسر العربى** · نوفمبر 18, 2015

تفضل اخي الغالي تطبيق لكود الاستاذ الغالي العيدروس له كل الشكر والتقدير

بالفعل الكود يعمل

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة.rar

**ناصرالمصرى** · نوفمبر 18, 2015

اخى الفاضل / العيدروس

تحية الله عليك

نوع الاوفيس 2007

تم بحمد الله تعالى

وارجو تفسير السطر الاول من الكود من منطلق لازم نفهم

()مستطلمستدير الزاويا 1 - انقر sub

معنى مستطيل مستدير الزاويا

وهذا الجزء من السطر

(( 4123 - )

  Ws.Range("Am8:Am" & L).SpecialCells(-4123)).Copy Sheets("Total").[J8]

وافر تقديرى واحترامى

اخى ياسر

السلام عليكم

تم بحمد الله

وافر تقديرى واحترامى

تم تعديل نوفمبر 18, 2015 بواسطه ناصر المصرى

**ناصرالمصرى** · نوفمبر 18, 2015

السلام عليكم

واجهتنى مشكلة أخرى وهى وراء ظهور رسالة الخطأ

المنوه عنها يالمشاركة 3 فكيف يمكن مسح محتوى

الصفوف التى بين الجدوال أولا ومن ثم الترحيل ثانيا

كما تفضل أخى العزيز / ابو نصار للتوضيح بالمرفق التالى

شاكر فضلكم مع قبول وافر احترامى

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة +123.rar

**الـعيدروس** · نوفمبر 18, 2015

اقتباس

()مستطلمستدير الزاويا 1 - انقر sub

مجرد تسمية للكود بإمكانك تسمية ماتشاء مثلاً Sub Naser_Almsre ()

اسم فقط

اقتباس

(( 4123 - )

هذا يرمز الى تحديد الخلايا التي تحتوي على صيغه

الملاحظ انا عمود Am يحتوي على صيغ فقط لذا عبرنا

عن التي تحتوي على صيغه

اما بخصوص مرفقك الاخير لم افهم طلبك

بخصوص الجدول هل ملفك الاساسي به جداول

وبينها فراغات اما جداول وبينها اسطر قيم ؟

**ناصرالمصرى** · نوفمبر 19, 2015

شاكر فضلك اخى الفاضل ابو نصار

على توضيحك المميز

بخصوص ملفى الاساسى به نفس الجدوال

اما الاسطر التى بين الجدوال

وعددها ثابت فهى تحتوى على تذييل

لتلك الجدوال كالتوفيعات فمن هنا وردت رسالة الخطأ

شاكر فضلك اخى الكريم وشاكر مجهودك الطيب

تقيل وافر تقديرى واحترامى

تم تعديل نوفمبر 19, 2015 بواسطه ناصر المصرى

**الـعيدروس** · نوفمبر 19, 2015

السلام عليكم

جرب التالي

Sub Ali_A()
Dim Ws As Worksheet, L
Dim Rng As Range
Dim Rn As Range
Set Ws = Sheets("salary")
L = Split(Ws.UsedRange.Address, "$")(4)
For Each Rng In Union(Ws.Range("C8:C" & L), Ws.Range("AM8:AM" & L))
  If Rng.Borders(xlEdgeRight).LineStyle <> -4142 Then
    If Not Rng Is Nothing Then
      If Rn Is Nothing Then
        Set Rn = Rng
       Else
        Set Rn = Union(Rn, Rng)
      End If
    End If
  End If
Next
With Sheets("Total")
If Not Rn Is Nothing Then
  Rn.Copy
  .[J8].Select
  .Paste
End If
End With
Application.CutCopyMode = False
Set Rn = Nothing
Set Rng = Nothing
End Sub

**ناصرالمصرى** · نوفمبر 19, 2015

اخى الفاضل ابو نصار

السلام عليكم

مع تنفيذ الكود ظهرت رسالة خطأ

بهذا السطر

تقيل وافر تقديرى واحترامى

  .[J8].Select

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديد 333.rar

تم تعديل نوفمبر 19, 2015 بواسطه ناصر المصرى

**الـعيدروس** · نوفمبر 19, 2015

اضف هذا السطر اول الكود وجرب

On Error Resume next

**ياسر العربى** · نوفمبر 19, 2015

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

j8

فانا ريحت دماغي ومفكرتش ابحث وخبطت كدا علي طول

علي حد علمي البسيط

Sub Ali_A()
Dim Ws As Worksheet, L
Dim Rng As Range
Dim Rn As Range
On Error Resume Next
Set Ws = Sheets("salary")
L = Split(Ws.UsedRange.Address, "$")(4)
For Each Rng In Union(Ws.Range("C8:C" & L), Ws.Range("AM8:AM" & L))
  If Rng.Borders(xlEdgeRight).LineStyle <> -4142 Then
    If Not Rng Is Nothing Then
      If Rn Is Nothing Then
        Set Rn = Rng
       Else
        Set Rn = Union(Rn, Rng)
      End If
    End If
  End If
Next
With Sheets("Total")
If Not Rn Is Nothing Then
  Rn.Copy
   Application.ScreenUpdating = False
   Sheet7.Activate
  .[j8].Select
  .Paste
   Sheet3.Activate
   Application.ScreenUpdating = True
End If
End With
Application.CutCopyMode = False
Set Rn = Nothing
Set Rng = Nothing
End Sub

وعذرا علي التخبيط اللي عملناه في كودك :wink2:

تم تعديل نوفمبر 19, 2015 بواسطه ياسر العربى

**الـعيدروس** · نوفمبر 19, 2015

الاخ الفاضل ياسر العربي

خبط وزبط زي ماانت عايز ان شاء الله يعمل معاه تعديلك

تحياتي

**ناصرالمصرى** · نوفمبر 19, 2015

والله ماهو تخبيط ده أحلى كلام

جهد مشكور تؤجران عليه من رب العباد

تم بحمد الله

شاكر فضلك حبيبى ابونصار

شاكر فضلك حبيبى ياسر

وافر تقديرى واحترامى

تم تعديل نوفمبر 19, 2015 بواسطه ناصر المصرى

**ناصرالمصرى** · نوفمبر 19, 2015

اخى الفاضل ابو نصار

اخى الفاضل ياسر العربى

جزاكم الله عنى خير الجزاء

**ناصرالمصرى** · نوفمبر 20, 2015

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

عذرا إحوانى الافاضل

على مايبدو أن السطر التالى له سحر غريب لاأستطيع إستيعابه كما ينبغى

  If Rng.Borders(xlEdgeRight).LineStyle <> -4142 Then

تم التعديل ليشمل الترحيل على عدة أعمدة وتم إضافة صف يحتوى على الاجمالى

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

لعدم ظهور تلك الصفين مع عملية الترحيل بالورقة " salary "

اليكم هذا الملف للتوضيح **** وافر تقديرى واحترامى

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة + 4444.rar

**ياسر العربى** · نوفمبر 20, 2015

السطر دا ياحبي بيشوف النطاق اللي معمول له بوردر يعني جرب كدا من وسط الصفوف اعمل صف من غير بوردر هتلاقيه تجنبه زي ما تجنب السبع صفوف بين كل مجموعة اسماء

كل اللي عليك خلي الخلايا بتاعتهم من غير حدود بوردر

**الـعيدروس** · نوفمبر 20, 2015

اقتباس


If Rng.Borders(xlEdgeRight).LineStyle <> -4142 Then

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

عموماً جرب التعديل التالي مع اضافة شرط استثناء السطر اذا كانت الخليه المجاوره

اي العمود A وجد فيها كلمة "كشف"

Sub Ali_A()
Dim Ws As Worksheet, L
Dim Rng As Range
Dim Rn As Range
Dim Rx$
On Error Resume Next
Set Ws = Sheets("salary"): Tx = "كشف"
L = Split(Ws.UsedRange.Address, "$")(4)
For Each Rng In Union(Ws.Range("C8:F" & L), Ws.Range("AO8:AO" & L))
  If Rng.Borders(xlEdgeRight).LineStyle <> -4142 _
  And Not Trim(Ws.Cells(Rng.Row, 1)) Like "*" & Tx & "*" Then
    If Not Rng Is Nothing Then
      If Rn Is Nothing Then
        Set Rn = Rng
       Else
        Set Rn = Union(Rn, Rng)
      End If
    End If
  End If
Next
With Sheets("Total")
If Not Rn Is Nothing Then
  Rn.Copy
   Application.ScreenUpdating = False
   Sheet1.Activate
  .[F8].Select
  .Paste
   Application.ScreenUpdating = True
End If
End With
Application.CutCopyMode = False
Set Rn = Nothing
Set Rng = Nothing
End Sub

تحياتي

اخي ياسر العربي كفيت ووفيت

الظاهر نشرت الرد وانا اكتب الرد

تحياتي لك

**ناصرالمصرى** · نوفمبر 20, 2015

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

أدرك حديثك جيدا ولكنى قمت بعدة تعديلات

والدليل أن الموضوع أختلف بإضافة هذين السطرين لاخى الفاضل / ابو نصار

Set Ws = Sheets("salary"): Tx = "ßÔÝ"

وهذا ايضا

  And Not Trim(Ws.Cells(Rng.Row, 1)) Like "*" & Tx & "*" Then

عموما جارى التعديل على الملف الاصلى

وافر تقديرى واحترامى

تم تعديل نوفمبر 20, 2015 بواسطه ناصر المصرى

**ياسر العربى** · نوفمبر 20, 2015

يأخي جرب قبل ما تتكلم

هذا الملف بدون تغيير الكود نهائيا

وقبل تجربة كود استاذنا الغالي ابو نصار

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة + 4444.rar

**ناصرالمصرى** · نوفمبر 20, 2015

طيب ياحاج ياسر أنت بتشخط فيه ليه

هههههههههه

والله ياحبيب قلبى كتر تركيز

وماادراك لما الدماغ بتركب

عموما انتهى الموضوع

سواء بهذا أو باضافة تلك السطرين للقدير ابو نصار فكلاهما صحيح

شاكر فضلك وتقبل وافر تقديرى

اخى الفاضل ابو نصار

أستاذ ياأبنى ورئيس قسم

سلمت يمناك وبارك فيك وفى نصار

وبهذا الموضوع الاكثر من رائع

المكنة طلعت

قماااااااااااااااااااااش

والله واشتغلت واشتغلت

جزاكم الله تعالى عنى خير الجزاء

وافر تقديرى واحترامى

تم تعديل نوفمبر 20, 2015 بواسطه ناصر المصرى

**ناصرالمصرى** · نوفمبر 22, 2015

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

عودة بإخوانى الاعزاء

هل يمكن إضافة كود لابجدة الاسماء لكود القدير أخى ابو نصار

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

مع عمل تسلسل تلقائى أم يستدعى الامر لاضافة شيت أخر بموديول جديد لتنفيذ ذلك

وافر تقديرى واحترامى

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة + 55.rar

**ياسر العربى** · نوفمبر 22, 2015

اتفضل ياريس

مش ورايا غيرك بقي

:wink2: :wink2:

يارب يكون المطلوب

ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة + 55.rar

تم تعديل نوفمبر 22, 2015 بواسطه ياسر العربى

تسجيل الدخول

ترحيل بيانات ترحيل بيانات أعمدة محددة و بدون صفوف فارغة لورقة عمل جديدة

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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

انشئ حساب جديد

تسجيل دخول

محتوي مشابه

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

Important Information