السلام عليكم
جرب الكود التالي للترحيل
Sub Macro1()
Dim ShName As String
Dim Lr As Long
ShName = Format(Range("C1"), "MMMM")
With Worksheets(ShName)
Lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & Lr).Resize(4, 1).Value = Range("C1").Value
Range("B7:L7").Resize(4).Copy
.Range("B" & Lr).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub
المرفق 2010
نظام حضور الدورات التدريبية.rar
تحياتي