كود نقل اصفف على حسب اسم الشهر

[محمد عبد الناصر]

في الملف المرفق اريد ان يقوم بنقل الاصفف المحددة باسم الشهر 

فمثلا اذا كان اسم الشهر في الصف يناير 

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

12.xlsm

[سليم حاصبيا]

<رب هذا الملف

Sub each_row_to_Its_sheet()
Dim lr, i, x
Dim sh As Worksheet
Sheets("jan").Range("a2").CurrentRegion.Offset(1).ClearContents
Sheets("Feb").Range("a2").CurrentRegion.Offset(1).ClearContents
Sheets("Mar").Range("a2").CurrentRegion.Offset(1).ClearContents
With Sheets("Legal")
lr = .Cells(Rows.Count, 1).End(3).Row
 For i = 3 To lr
 If Not IsDate(.Cells(i, 2)) Then GoTo next_i
  Select Case Month(.Cells(i, 2))
   Case 1: Set sh = Sheets("jan")
   Case 2: Set sh = Sheets("Feb")
   Case 3: Set sh = Sheets("Mar")
   Case Else: GoTo next_i
  End Select
   x = sh.Cells(Rows.Count, 1).End(3).Row + 1
    sh.Cells(x, 1).Resize(, 5).Value = _
    .Cells(i, 1).Resize(, 5).Value
next_i:
 Next i
End With
End Sub

الملف مرفق

Naser.xlsm

[محمد عبد الناصر]

تحيه الك اخي الكريم ماشاء الله عليك تسلم