فلتر متقدم

[أبو جاسم]

السلام عليكم

دا شيت ياجماعه انا كل اللي محتاجه انه يجبلي كل اداره لوحدها بس يعني مجرد اني اعمله كود يجبلي كل اداره لوحدها بدون اي شئ

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

انا لسه هاكمل البيانات من الشيت

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

26 دقائق مضت, م. سعيد said:

السلام عليكم

دا شيت ياجماعه انا كل اللي محتاجه انه يجبلي كل اداره لوحدها بس يعني مجرد اني اعمله كود يجبلي كل اداره لوحدها بدون اي شئ

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

انا لسه هاكمل البيانات من الشيت

السلام عليكم

جرب المرفق

 

Salary Sheet.rar

[أبو جاسم]

تسلم أبو حنين

ولاكن كود الحذف مش شغال

وممكن حضرتك تقلي الكود ايه بتاع توزيع إلى إدارات

تقبل تحياتي

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

مرحبا

هذا الكود يقوم بالتوزيع

Sub dddd()
Application.ScreenUpdating = False
    Dim Rng As Range, cel As Range, i As Integer, My_SHYTES As New Collection
    Set Rng = Range("M4:M" & Cells(Rows.Count, 13).End(xlUp).Row)
    On Error Resume Next
    For Each cel In Rng
        My_SHYTES.Add cel.Value, CStr(cel.Value)  '
    Next cel

For i = 1 To My_SHYTES.Count
Sheets.Add After:=Sheets(Sheets.Count)
Set SH = ActiveSheet
With SH
.Name = My_SHYTES(i)
Sheets("Salary Sheet").Range("A3:AL3").Copy
.Range("A1").PasteSpecial xlPasteValues
.Range("A1:X1").Borders.Value = 1

.Range("A1:AL1").Font.Bold = True
.Range("A1:AL1").Interior.ColorIndex = 43
.Columns("A:AL").EntireColumn.AutoFit
End With
Next i
'ScOpy

End Sub

 

 

 

و هذا الكود يقوم بالنسخ

 

 

Sub ScOpy()
Application.ScreenUpdating = False
Dim i As Integer, SH As Worksheet, HS As Worksheet, Lr As Integer, iLr As Integer
Set SH = Sheets("Salary Sheet")
With SH
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To Lr 'Sheets.Count
For Each HS In Sheets
If HS.Name = SH.Cells(i, 13) Then
iLr = HS.Cells(Rows.Count, 1).End(xlUp).Row + 1
SH.Range("A" & i).Resize(, 38).Copy
HS.Range("A" & iLr).PasteSpecial (xlPasteValues)
HS.Range("A1:AL" & iLr).Borders.Value = 1
HS.Columns("A:AL").EntireColumn.AutoFit

End If
Next
Next
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Salary Sheet").Select

End Sub

 

[أبو جاسم]

يعني الاتنين يكونو في Modules واحده

وهو معني كلمه نسخ يعني ياخد نسخه من اللموجود

[أبو جاسم]

استاذي العزيز ابو حنين

ليه طلب ان شاء الله حضرتك تساعدني فيه

انا عاوز معادلة تجبلي من كل الملفات الموجودة وتكون في الشيت الرئيسي

امام كل رقم وظيفي لكل موظف اذا موجود

والشرح اكثر في الملف المرفق

تحياتي

New.rar