تکرار یک مقدار با تعداد مشخص در اکسل

[reza_1001]

با سلام و خسته نباشید خدمت همه اساتید و دوستان
بنده یک مشکلی در اجرای sub دارم بدین صورت که :
میخواهم a1 را 24 بار تکرار کنم ، 24 بار تکرار میشه ولی هر بار 1 واحد اضافه میشه .
نمیدونم مشکل فرمول کجاس ، لطفا کمکم کنید .
اینم فرمول :

Sub Macro1()
'
' Macro1 Macro
'


'
j = 1
For i = 1 To 161
Range("A" & i & ":G" & i).Copy
Range("I" & j).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("I" & j & ":O" & j + 24), Type:=xlFillDefault
j = j + 24
Next i
ActiveWorkbook.Save
End Sub

[~M*E*H*D*I~]

منظور از a1 اگر تو قطه کد

Range("A" & i & ":G" & i) 

هست ، خیلی واضحه شما شمارنده i رو به a اختصاص دادید بنابر این ستون a ردیف های 1 الی 24 را انتخاب میکنید برای ایکه سلول a1 ثابت باشه نباید براش شمارنده بذارید

[reza_1001]

سلام آقا مهدی ....لطفا فرمول اصلاح شده رو مینویسید

[~M*E*H*D*I~]

سلام آقا مهدی ....لطفا فرمول اصلاح شده رو مینویسید

سلام به شما ، اون g هم باید ثابت باشه؟یعنی رنج a1:g1 ؟

[reza_1001]

بله باید ثابت باشه

[~M*E*H*D*I~]

بایستی به صورت زیر بنویسید

for i=1 to 24
range("a1:g1").copy
next i 

[reza_1001]

اقا مهدی فایل رو پیوست کردم ، لطفا ببینیدش ، بنده میخوام که a1 رو 24 بار تکرار کنه و سپس a2 رو 24 بار کنه و الی آخر .

[~M*E*H*D*I~]

از کد زیر میتونی استفاده کنی

Sub InsertRows()
    Dim I As Long, j As Integer, Nb As Integer
    
    For I = Range("A65536").End(xlUp).Row To 1 Step -1
        
             Nb = 24
        
        For j = 1 To Nb - 1
            Rows(I + j).Insert xlDown
            Rows(I).Copy
            Rows(I + j).PasteSpecial    '
        Next
        
    Next
  
    Range("A1").Select
    Application.CutCopyMode = False
End Sub 

[~M*E*H*D*I~]

از کد زیر هم میتونی استفاده کنی

Sub test()
Dim i As Integer, j As Integer, n As Integer, p As Integer
Dim tedadcell As Integer
Dim tedadtekrar As Integer
tedadcell = 20
tedadtekrar = 15
n = 0
For j = 1 To tedadcell
  For i = j To tedadtekrar + j - 1
  Cells(j, 1).Copy
  Cells(i + n, 4).PasteSpecial xlPasteValues
  Next i
  n = n + tedadtekrar - 1
  Next j
 
End Sub