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

[2saad]

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

محتاج كود بسيط يرحل الأعمدة المحددة في شيت 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

 

تم تعديل مارس 3, 2023 بواسطه ابراهيم الحداد

[2saad]

شكرا جزيلا أستاذنا الفاضل علي مجهودك الرائع

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

وعشمان في كود يقوم بمسح البيانات في شيت مجمع عندما اختار فصل آخر

[ابراهيم الحداد]

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

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

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

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

 

[2saad]

والله ما عارف اقولك ايه 

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

وأنا بتعب حضرتك معاي كتير

واستفدت من حضرتك كتير