اخوتي الاعزاء شكرا لاهتمامكم
استخدمت هذا الكود وتجاوزت المعضلة
Sub add_sheets()
' add_sheets macro & sheets rename
Dim x As Integer
Dim myR As Variant
myR = ("k1:k369")
'we can chenge the range that we neded
For Each myR In Range("k1:k369")
For x = 1 To 369
Sheets("Sheet1").Select
Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets("sheet1").Select
myR.Select
Selection.Copy
Sheets("Sheet1 (2)").Name = myR(x)
Next
Next myR
End Sub