اذهب الي المحتوي
أوفيسنا

كود ترحيل بسيط


2saad
إذهب إلى أفضل إجابة Solved by ابراهيم الحداد,

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

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

محتاج كود بسيط يرحل الأعمدة المحددة في شيت 1 و2 و 3 الي شيت ( مجمع )  بناء علي القائمة المنسدلة في الخلية ( s4 )

ولكم جزيل الشكررزان.xlsm

رزان.xlsm

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

  • أفضل إجابة

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

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

Sub ColData()
Dim ws As Worksheet, Sh As Worksheet
Dim LR  As Long, i As Long
Dim Arr As Variant, C As Range
Dim p As Long, FSL As String
Set ws = Sheets("مجمع")
ws.Range("C9:H100")=""
FSL = ws.Range("S4")
1 '-----------------
On Error Resume Next
For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
LR = Sh.Range("O" & Rows.Count).End(3).Row
i = i + LR
Next
2  '-----------------
ReDim Arr(i, 6)
p = 0
For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
For Each C In Sh.Range("O10:O" & LR)
If C.Value = FSL Then
Arr(p, 0) = p + 1
Arr(p, 1) = C.Offset(0, -10).Value
Arr(p, 2) = C.Offset(0, -6).Value
Arr(p, 3) = C.Offset(0, -4).Value
Arr(p, 4) = C.Value
Arr(p, 5) = C.Offset(0, 1).Value
p = p + 1
End If
Next
Next
3  '-----------------
If p > 0 Then ws.Range("C9").Resize(p, 6).Value = Arr
4  '-----------------
End Sub

 

تم تعديل بواسطه ابراهيم الحداد
  • Like 4
  • Thanks 1
رابط هذا التعليق
شارك

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

هذه الجزئية فى الكود السابق من شأنها مسح البيانات السابقة قبل ترحيل الفصل المطلوب

ws.Range("C9:H100")=""

اعد نسخ الكود مرة اخرى و سوف تراها

 

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

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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

Important Information